X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProtout.pm;h=75903f02912e25b2d0c29b808635a8779f799415;hb=937b3f6592ae13be16dfe171b30817ee39d27bf0;hp=6917b88b8501b384d34fa958464911e4f54aa975;hpb=cd0c19a8aeee5313a8963841cb85daa84eb1aa88;p=spider.git diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index 6917b88b..75903f02 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -6,8 +6,8 @@ # # Copyright (c) 1998 Dirk Koopman G1TLH # -# $Id$ -# +# +# package DXProt; @@ -19,16 +19,10 @@ use DXDebug; use strict; -use vars qw($VERSION $BRANCH); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; - -use vars qw($sentencelth); +use vars qw($sentencelth $pc19_version); $sentencelth = 180; - + # # All the PCxx generation routines # @@ -38,7 +32,7 @@ sub pc10 { my ($from, $to, $via, $text, $origin) = @_; my ($user1, $user2); - if ($via && $via ne $to) { + if ($via && $via ne $to && $via ne '*') { $user1 = $via; $user2 = $to; } else { @@ -49,10 +43,10 @@ sub pc10 $text = unpad($text); $text = ' ' unless $text && length $text > 0; $text =~ s/\^/%5E/g; - return "PC10^$from^$user1^$text^*^$user2^$origin^~"; + return "PC10^$from^$user1^$text^*^$user2^$origin^~"; } -# create a dx message (call, freq, dxcall, text) +# create a dx message (call, freq, dxcall, text) sub pc11 { my ($mycall, $freq, $dxcall, $text) = @_; @@ -66,19 +60,20 @@ sub pc11 # create an announce message sub pc12 { - my ($call, $text, $tonode, $sysop, $wx) = @_; + my ($call, $text, $tonode, $sysop, $wx, $origin) = @_; my $hops = get_hops(12); - $sysop = ' ' if !$sysop; - $text = ' ' if !$text; - $wx = '0' if !$wx; - $tonode = '*' if !$tonode; + $text ||= ' '; $text =~ s/\^/%5E/g; - return "PC12^$call^$tonode^$text^$sysop^$main::mycall^$wx^$hops^~"; + $tonode ||= '*'; + $sysop ||= ' '; + $wx ||= '0'; + $origin ||= $main::mycall; + return "PC12^$call^$tonode^$text^$sysop^$origin^$wx^$hops^~"; } # -# add one or more users (I am expecting references that have 'call', -# 'conf' & 'here' method) +# add one or more users (I am expecting references that have 'call', +# 'conf' & 'here' method) # # this will create a list of PC16 with up pc16_max_users in each # called $self->pc16(..) @@ -94,13 +89,13 @@ sub pc16 next unless $_; my $ref = $_; my $str = sprintf "^%s %s %d", $ref->call, $ref->conf ? '*' : '-', $ref->here; - if (length($s) + length($str) >= $sentencelth) { + if (length($s) + length($str) > $sentencelth) { push @out, "PC16^$ncall" . $s . sprintf "^%s^", get_hops(16); $s = ""; } $s .= $str; } - push @out, "PC16^$ncall" . $s . sprintf "^%s^", get_hops(16) if length $s; + push @out, "PC16^$ncall" . $s . sprintf "^%s^", get_hops(16); return @out; } @@ -114,7 +109,7 @@ sub pc17 my $hops = get_hops(17); my $ncall = $node->call; my $ucall = $ref->call; - push @out, "PC17^$ucall^$ncall^$hops^"; + push @out, "PC17^$ucall^$ncall^$hops^"; } return @out; } @@ -122,12 +117,13 @@ sub pc17 # Request init string sub pc18 { - return "PC18^DXSpider Version: $main::version Build: $main::build^$DXProt::myprot_version^"; + my $flags = shift; + return "PC18^DXSpider Version: $main::version Build: $main::subversion.$main::build$flags^$DXProt::myprot_version^"; } # -# add one or more nodes -# +# add one or more nodes +# sub pc19 { my @out; @@ -141,14 +137,16 @@ sub pc19 my $here = $ref->here; my $conf = $ref->conf; my $version = $ref->version; + $version = $pc19_version unless $version =~ /^\d\d\d\d$/; + my $str = "^$here^$call^$conf^$version"; - if (length($s) + length($str) >= $sentencelth) { + if (length($s) + length($str) > $sentencelth) { push @out, "PC19" . $s . sprintf "^%s^", get_hops(19); $s = ""; } $s .= $str; } - push @out, "PC19" . $s . sprintf "^%s^", get_hops(19) if length $s; + push @out, "PC19" . $s . sprintf "^%s^", get_hops(19); return @out; } @@ -184,12 +182,12 @@ sub pc24 my $call = $self->call; my $flag = $self->here ? '1' : '0'; my $hops = shift || get_hops(24); - + return "PC24^$call^$flag^$hops^"; } -# create a merged dx message (freq, dxcall, t, text, spotter, orig-node) +# create a merged dx message (freq, dxcall, t, text, spotter, orig-node) sub pc26 { my ($freq, $dxcall, $t, $text, $spotter, $orignode) = @_; @@ -218,7 +216,7 @@ sub pc28 } # message text (from and to node same way round as pc29) -sub pc29 +sub pc29 { my ($fromnode, $tonode, $stream, $text) = @_; $text = ' ' unless defined $text && length $text > 0; @@ -296,7 +294,7 @@ sub pc41 { my $call = shift; $call = shift if ref $call; - + my $sort = shift || '0'; my $info = shift || ' '; my $hops = shift || get_hops(41); @@ -371,9 +369,96 @@ sub pc85 return "PC85^$tonode^$fromnode^$call^$msg^~"; } -# spider route broadcast -sub pc90 +# spider route broadcasts +# + + +sub _gen_pc92 +{ + my $sort = shift; + my $ext = shift; + my $s = "PC92^$main::mycall^" . gen_pc9x_t() . "^$sort"; + for (@_) { + $s .= "^" . _encode_pc92_call($_, $ext); + $ext = 0; # only the first slot has an ext. + } + return $s . '^H99^'; +} + +sub gen_pc92_with_time { + my $call = shift; + my $sort = shift; + my $t = shift; + my $ext = 1; + my $s = "PC92^$call^$t^$sort"; + for (@_) { + $s .= "^" . _encode_pc92_call($_, $ext); + } + return $s . '^H99^'; +} + +# add a local one +sub pc92a +{ + return _gen_pc92('A', 0, @_); +} + +# delete a local one +sub pc92d +{ + return _gen_pc92('D', 0, @_); +} + +# send a config +sub pc92c +{ + return _gen_pc92('C', 1, @_); +} + +# send a keep alive +sub pc92k +{ + my $nref = shift; + my $s = "PC92^$main::mycall^" . gen_pc9x_t() . "^K"; + $s .= "^" . _encode_pc92_call($nref, 1); + $s .= "^" . scalar $nref->nodes; + $s .= "^" . scalar $nref->users; + return $s . '^H99^'; +} + +# send a 'find' message +sub pc92f +{ + my $target = shift; + my $from = shift; + return "PC92^$main::mycall^" . gen_pc9x_t() . "^F^$from^$target^H99^" +} + +# send a 'reply' message +sub pc92r +{ + my $to = shift; + my $target = shift; + my $flag = shift; + my $ms = shift; + return "PC92^$main::mycall^" . gen_pc9x_t() . "^R^$to^$target^$flag^$ms^H99^" +} + +sub pc93 +{ + my $to = shift; # *, callsign, chat group name, sysop + my $from = shift; # from user callsign + my $via = shift || '*'; # *, node call + my $line = shift; # the text + my $origin = shift; # this will be present on proxying from PC10 + + $line = unpad($line); + $line =~ s/\^/\\5E/g; # remove any ^ characters + my $s = "PC93^$main::mycall^" . gen_pc9x_t() . "^$to^$from^$via^$line"; + $s .= "^$origin" if $origin; + $s .= "^H99^"; + return $s; } 1;