X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProtout.pm;h=9a782960827068a10265f69f84ab17044283749c;hb=69c8aeb338cc485103e289fbab7ec4e7e056ed20;hp=a5d5250b161014a817ce5d0c334035600018a18b;hpb=0f8cb479221e09bae8e03447c78527604cf69be4;p=spider.git diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index a5d5250b..9a782960 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -26,34 +26,34 @@ use strict; # create a talk string ($from, $to, $via, $text) sub pc10 { - my ($from, $to, $via, $text) = @_; - my $user2 = $via ? $to : ' '; - my $user1 = $via ? $via : $to; - $text = unpad($text); - $text = ' ' if !$text; - return "PC10^$from^$user1^$text^*^$user2^$main::mycall^~"; + my ($from, $to, $via, $text) = @_; + my $user2 = $via ? $to : ' '; + my $user1 = $via ? $via : $to; + $text = unpad($text); + $text = ' ' if !$text; + return "PC10^$from^$user1^$text^*^$user2^$main::mycall^~"; } # create a dx message (call, freq, dxcall, text) sub pc11 { - my ($mycall, $freq, $dxcall, $text) = @_; - my $hops = get_hops(11); - my $t = time; - $text = ' ' if !$text; - return sprintf "PC11^%.1f^$dxcall^%s^%s^$text^$mycall^$hops^~", $freq, cldate($t), ztime($t); + my ($mycall, $freq, $dxcall, $text) = @_; + my $hops = get_hops(11); + my $t = time; + $text = ' ' if !$text; + return sprintf "PC11^%.1f^$dxcall^%s^%s^$text^$mycall^$hops^~", $freq, cldate($t), ztime($t); } # create an announce message sub pc12 { - my ($call, $text, $tonode, $sysop, $wx) = @_; - my $hops = get_hops(12); - $sysop = ' ' if !$sysop; - $text = ' ' if !$text; - $wx = '0' if !$wx; - $tonode = '*' if !$tonode; - return "PC12^$call^$tonode^$text^$sysop^$main::mycall^$wx^$hops^~"; + my ($call, $text, $tonode, $sysop, $wx) = @_; + my $hops = get_hops(12); + $sysop = ' ' if !$sysop; + $text = ' ' if !$text; + $wx = '0' if !$wx; + $tonode = '*' if !$tonode; + return "PC12^$call^$tonode^$text^$sysop^$main::mycall^$wx^$hops^~"; } # @@ -65,29 +65,29 @@ sub pc12 # sub pc16 { - my $self = shift; - my @out; + my $self = shift; + my @out; - foreach (@_) { - my $str = "PC16^$self->{call}"; - my $i; + foreach (@_) { + my $str = "PC16^$self->{call}"; + my $i; - for ($i = 0; @_ > 0 && $i < $DXProt::pc16_max_users; $i++) { - my $ref = shift; - $str .= sprintf "^%s %s %d", $ref->call, $ref->confmode ? '*' : '-', $ref->here; + for ($i = 0; @_ > 0 && $i < $DXProt::pc16_max_users; $i++) { + my $ref = shift; + $str .= sprintf "^%s %s %d", $ref->call, $ref->confmode ? '*' : '-', $ref->here; + } + $str .= sprintf "^%s^", get_hops(16); + push @out, $str; } - $str .= sprintf "^%s^", get_hops(16); - push @out, $str; - } - return (@out); + return (@out); } # remove a local user sub pc17 { - my ($self, $ref) = @_; - my $hops = get_hops(17); - return "PC17^$ref->{call}^$self->{call}^$hops^"; + my ($self, $ref) = @_; + my $hops = get_hops(17); + return "PC17^$ref->{call}^$self->{call}^$hops^"; } # Request init string @@ -102,102 +102,102 @@ sub pc18 # sub pc19 { - my $self = shift; - my @out; + my $self = shift; + my @out; - while (@_) { - my $str = "PC19"; - my $i; + while (@_) { + my $str = "PC19"; + my $i; - for ($i = 0; @_ && $i < $DXProt::pc19_max_nodes; $i++) { - my $ref = shift; - my $here = $ref->{here} ? '1' : '0'; - my $confmode = $ref->{confmode} ? '1' : '0'; - $str .= "^$here^$ref->{call}^$confmode^$ref->{pcversion}"; + for ($i = 0; @_ && $i < $DXProt::pc19_max_nodes; $i++) { + my $ref = shift; + my $here = $ref->{here} ? '1' : '0'; + my $confmode = $ref->{confmode} ? '1' : '0'; + $str .= "^$here^$ref->{call}^$confmode^$ref->{pcversion}"; + } + $str .= sprintf "^%s^", get_hops(19); + push @out, $str; } - $str .= sprintf "^%s^", get_hops(19); - push @out, $str; - } - return @out; + return @out; } # end of Rinit phase sub pc20 { - return 'PC20^'; + return 'PC20^'; } # delete a node sub pc21 { - my ($call, $reason) = @_; - my $hops = get_hops(21); - $reason = "Gone." if !$reason; - return "PC21^$call^$reason^$hops^"; + my ($call, $reason) = @_; + my $hops = get_hops(21); + $reason = "Gone." if !$reason; + return "PC21^$call^$reason^$hops^"; } # end of init phase sub pc22 { - return 'PC22^'; + return 'PC22^'; } # here status sub pc24 { - my $self = shift; - my $call = $self->call; - my $flag = $self->here ? '1' : '0'; - my $hops = get_hops(24); + my $self = shift; + my $call = $self->call; + my $flag = $self->here ? '1' : '0'; + my $hops = get_hops(24); - return "PC24^$call^$flag^$hops^"; + return "PC24^$call^$flag^$hops^"; } # message start (fromnode, tonode, to, from, t, private, subject, origin) sub pc28 { - my ($tonode, $fromnode, $to, $from, $t, $private, $subject, $origin, $rr) = @_; - my $date = cldate($t); - my $time = ztime($t); - $private = $private ? '1' : '0'; - $rr = $rr ? '1' : '0'; - return "PC28^$tonode^$fromnode^$to^$from^$date^$time^$private^$subject^ ^5^$rr^ ^$origin^~"; + my ($tonode, $fromnode, $to, $from, $t, $private, $subject, $origin, $rr) = @_; + my $date = cldate($t); + my $time = ztime($t); + $private = $private ? '1' : '0'; + $rr = $rr ? '1' : '0'; + return "PC28^$tonode^$fromnode^$to^$from^$date^$time^$private^$subject^ ^5^$rr^ ^$origin^~"; } # message text (from and to node same way round as pc29) sub pc29 { - my ($fromnode, $tonode, $stream, $text) = @_; - $text =~ s/\^//og; # remove ^ - return "PC29^$fromnode^$tonode^$stream^$text^~"; + my ($fromnode, $tonode, $stream, $text) = @_; + $text =~ s/\^//og; # remove ^ + return "PC29^$fromnode^$tonode^$stream^$text^~"; } # subject acknowledge (will have to and from node reversed to pc28) sub pc30 { - my ($fromnode, $tonode, $stream) = @_; - return "PC30^$fromnode^$tonode^$stream^"; + my ($fromnode, $tonode, $stream) = @_; + return "PC30^$fromnode^$tonode^$stream^"; } # acknowledge this tranche of lines (to and from nodes reversed to pc29 and pc28 sub pc31 { - my ($fromnode, $tonode, $stream) = @_; - return "PC31^$fromnode^$tonode^$stream^"; + my ($fromnode, $tonode, $stream) = @_; + return "PC31^$fromnode^$tonode^$stream^"; } # end of message from the sending end (pc28 node order) sub pc32 { - my ($fromnode, $tonode, $stream) = @_; - return "PC32^$fromnode^$tonode^$stream^"; + my ($fromnode, $tonode, $stream) = @_; + return "PC32^$fromnode^$tonode^$stream^"; } # acknowledge end of message from receiving end (opposite pc28 node order) sub pc33 { - my ($fromnode, $tonode, $stream) = @_; - return "PC33^$fromnode^$tonode^$stream^"; + my ($fromnode, $tonode, $stream) = @_; + return "PC33^$fromnode^$tonode^$stream^"; } # remote cmd send @@ -217,70 +217,70 @@ sub pc35 # send all the DX clusters I reckon are connected sub pc38 { - my @list = DXNode->get_all(); - my $list; - my @nodes; + my @list = DXNode->get_all(); + my $list; + my @nodes; - foreach $list (@list) { - push @nodes, $list->call; - } - return "PC38^" . join(',', @nodes) . "^~"; + foreach $list (@list) { + push @nodes, $list->call; + } + return "PC38^" . join(',', @nodes) . "^~"; } # tell the local node to discconnect sub pc39 { - my ($call, $reason) = @_; - my $hops = get_hops(39); - $reason = "Gone." if !$reason; - return "PC39^$call^$reason^$hops^"; + my ($call, $reason) = @_; + my $hops = get_hops(39); + $reason = "Gone." if !$reason; + return "PC39^$call^$reason^$hops^"; } # cue up bulletin or file for transfer sub pc40 { - my ($to, $from, $fn, $bull) = @_; - $bull = $bull ? '1' : '0'; - return "PC40^$to^$from^$fn^$bull^5^"; + my ($to, $from, $fn, $bull) = @_; + $bull = $bull ? '1' : '0'; + return "PC40^$to^$from^$fn^$bull^5^"; } # user info sub pc41 { - my ($call, $sort, $info) = @_; - my $hops = get_hops(41); - $sort = $sort ? "$sort" : '0'; - return "PC41^$call^$sort^$info^$hops^~"; + my ($call, $sort, $info) = @_; + my $hops = get_hops(41); + $sort = $sort ? "$sort" : '0'; + return "PC41^$call^$sort^$info^$hops^~"; } # abort message sub pc42 { - my ($fromnode, $tonode, $stream) = @_; - return "PC42^$fromnode^$tonode^$stream^"; + my ($fromnode, $tonode, $stream) = @_; + return "PC42^$fromnode^$tonode^$stream^"; } # bull delete sub pc49 { - my ($from, $subject) = @_; - my $hops = get_hops(49); - return "PC49^$from^$subject^$hops^~"; + my ($from, $subject) = @_; + my $hops = get_hops(49); + return "PC49^$from^$subject^$hops^~"; } # periodic update of users, plus keep link alive device (always H99) sub pc50 { - my $me = DXCluster->get_exact($main::mycall); - my $n = $me->users ? $me->users : '0'; - return "PC50^$main::mycall^$n^H99^"; + my $me = DXCluster->get_exact($main::mycall); + my $n = $me->users ? $me->users : '0'; + return "PC50^$main::mycall^$n^H99^"; } # generate pings sub pc51 { - my ($to, $from, $val) = @_; - return "PC51^$to^$from^$val^"; + my ($to, $from, $val) = @_; + return "PC51^$to^$from^$val^"; } 1; __END__