From 9a55af9586711ecdea8dc9b0da38509119fa8090 Mon Sep 17 00:00:00 2001 From: djk Date: Tue, 22 Dec 1998 23:01:42 +0000 Subject: [PATCH] some detail changes to do with -w flags etc --- cmd/disconnect.pl | 2 +- cmd/dx.pl | 46 +++++++------- cmd/show/dxcc.pl | 136 +++++++++++++++++++++--------------------- perl/DXCluster.pm | 4 +- perl/DXCommandmode.pm | 33 +++++----- perl/DXLog.pm | 6 +- perl/DXMsg.pm | 7 ++- perl/DXProtout.pm | 2 +- perl/Geomag.pm | 3 +- 9 files changed, 126 insertions(+), 113 deletions(-) diff --git a/cmd/disconnect.pl b/cmd/disconnect.pl index 8bb48ccf..e8e83b89 100644 --- a/cmd/disconnect.pl +++ b/cmd/disconnect.pl @@ -16,7 +16,7 @@ foreach $call (@calls) { my $dxchan = DXChannel->get($call); if ($dxchan) { if ($dxchan->is_ak1a) { - $dxchan->send_now("D", DXProt::pc39($main::mycall, $self->msg('disc1'))); + $dxchan->send_now("D", DXProt::pc39($main::mycall, $self->msg('disc1', $self->call))); } else { $dxchan->send_now('D', $self->msg('disc1', $self->call)); } diff --git a/cmd/dx.pl b/cmd/dx.pl index 394cb7ab..763bf9b0 100644 --- a/cmd/dx.pl +++ b/cmd/dx.pl @@ -17,15 +17,17 @@ my @out; my $valid = 0; # first lets see if we think we have a callsign as the first argument -if ($f[0] =~ /[A-Za-z]/) { - $spotter = uc $f[0]; - $freq = $f[1]; - $spotted = uc $f[2]; - $line =~ s/^$f[0]\s+$f[1]\s+$f[2]\s*//; -} else { - $freq = $f[0]; - $spotted = uc $f[1]; - $line =~ s/^$f[0]\s+$f[1]\s*//; +if (defined @f && @f >= 3 && $f[0] =~ /[A-Za-z]/) { + $spotter = uc $f[0]; + $freq = $f[1]; + $spotted = uc $f[2]; + $line =~ s/^$f[0]\s+$f[1]\s+$f[2]\s*//; +} elsif (defined @f && @f >= 2) { + $freq = $f[0]; + $spotted = uc $f[1]; + $line =~ s/^$f[0]\s+$f[1]\s*//; +} elsif (!defined @f || @f < 2) { + return (1, $self->msg('dx2')); } # bash down the list of bands until a valid one is reached @@ -36,13 +38,13 @@ my $i; # first in KHz L1: foreach $bandref (Bands::get_all()) { - @bb = @{$bandref->band}; - for ($i = 0; $i < @bb; $i += 2) { - if ($freq >= $bb[$i] && $freq <= $bb[$i+1]) { - $valid = 1; - last L1; + @bb = @{$bandref->band}; + for ($i = 0; $i < @bb; $i += 2) { + if ($freq >= $bb[$i] && $freq <= $bb[$i+1]) { + $valid = 1; + last L1; + } } - } } if (!$valid) { @@ -50,7 +52,7 @@ if (!$valid) { # try again in MHZ $freq = $freq * 1000 if $freq; -L2: + L2: foreach $bandref (Bands::get_all()) { @bb = @{$bandref->band}; for ($i = 0; $i < @bb; $i += 2) { @@ -70,20 +72,20 @@ push @out, $self->msg('dx1', $freq) if !$valid; if ($spotted le ' ') { push @out, $self->msg('dx2'); - $valid = 0; + $valid = 0; } return (1, @out) if !$valid; # Store it here if (Spot::add($freq, $spotted, $main::systime, $line, $spotter)) { - # send orf to the users - my $buf = Spot::formatb($freq, $spotted, $main::systime, $line, $spotter); - DXProt::broadcast_users($buf); + # send orf to the users + my $buf = Spot::formatb($freq, $spotted, $main::systime, $line, $spotter); + DXProt::broadcast_users($buf); - # send it orf to the cluster (hang onto your tin helmets)! - DXProt::broadcast_ak1a(DXProt::pc11($spotter, $freq, $spotted, $line)); + # send it orf to the cluster (hang onto your tin helmets)! + DXProt::broadcast_ak1a(DXProt::pc11($spotter, $freq, $spotted, $line)); } return (1, @out); diff --git a/cmd/show/dxcc.pl b/cmd/show/dxcc.pl index 3a2911c5..f5826e47 100644 --- a/cmd/show/dxcc.pl +++ b/cmd/show/dxcc.pl @@ -5,7 +5,7 @@ # my ($self, $line) = @_; -my @list = split /\s+/, $line; # split the line up +my @list = split /\s+/, $line; # split the line up my @out; my $f; @@ -15,85 +15,85 @@ my ($fromday, $today); my @freq; my @ans; -while ($f = shift @list) { # next field - print "f: $f list: ", join(',', @list), "\n"; - if (!$from && !$to) { - ($from, $to) = $f =~ /^(\d+)-(\d+)$/o; # is it a from -> to count? - next if $from && $to > $from; - } - if (!$to) { - ($to) = $f =~ /^(\d+)$/o if !$to; # is it a to count? - next if $to; - } - if (lc $f eq 'on' && $list[0]) { # is it freq range? - print "yup freq\n"; - my @r = split '/', $list[0]; - print "r0: $r[0] r1: $r[1]\n"; - @freq = Bands::get_freq($r[0], $r[1]); - if (@freq) { # yup, get rid of extranous param - print "freq: ", join(',', @freq), "\n"; - shift @list; - next; +while ($f = shift @list) { # next field +# print "f: $f list: ", join(',', @list), "\n"; + if (!$from && !$to) { + ($from, $to) = $f =~ /^(\d+)-(\d+)$/o; # is it a from -> to count? + next if $from && $to > $from; + } + if (!$to) { + ($to) = $f =~ /^(\d+)$/o if !$to; # is it a to count? + next if $to; + } + if (lc $f eq 'on' && $list[0]) { # is it freq range? +# print "yup freq\n"; + my @r = split '/', $list[0]; +# print "r0: $r[0] r1: $r[1]\n"; + @freq = Bands::get_freq($r[0], $r[1]); + if (@freq) { # yup, get rid of extranous param +# print "freq: ", join(',', @freq), "\n"; + shift @list; + next; + } + } + if (lc $f eq 'day' && $list[0]) { +# print "got day\n"; + ($fromday, $today) = split '-', $list[0]; + shift @list; + next; + } + if (!@ans) { + @ans = Prefix::extract($f); # is it a callsign/prefix? } - } - if (lc $f eq 'day' && $list[0]) { - print "got day\n"; - ($fromday, $today) = split '-', $list[0]; - shift @list; - next; - } - if (!@ans) { - @ans = Prefix::extract($f); # is it a callsign/prefix? - } } # no dxcc country, no answer! -if (@ans) { # we have a valid prefix! +if (@ans) { # we have a valid prefix! - # first deal with the prefix - my $pre = shift @ans; - my $a; - my $expr = "("; - my $str = "Prefix: $pre"; - my $l = length $str; + # first deal with the prefix + my $pre = shift @ans; + my $a; + my $expr = "("; + my $str = "Prefix: $pre"; + my $l = length $str; - # build up a search string for this dxcc country/countries - foreach $a (@ans) { - $expr .= " || " if $expr ne "("; - my $n = $a->dxcc(); - $expr .= "\$f5 == $n"; - my $name = $a->name(); - $str .= " Dxcc: $n ($name)"; + # build up a search string for this dxcc country/countries + foreach $a (@ans) { + $expr .= " || " if $expr ne "("; + my $n = $a->dxcc(); + $expr .= "\$f5 == $n"; + my $name = $a->name(); + $str .= " Dxcc: $n ($name)"; + push @out, $str; + $str = pack "A$l", " "; + } + $expr .= ")"; push @out, $str; - $str = pack "A$l", " "; - } - $expr .= ")"; - push @out, $str; - # now deal with any frequencies specified - if (@freq) { - $expr .= " && ("; - my $i; - for ($i; $i < @freq; $i += 2) { - $expr .= "(\$f0 >= $freq[$i] && \$f0 <= $freq[$i+1]) ||"; + # now deal with any frequencies specified + if (@freq) { + $expr .= " && ("; + my $i; + for ($i = 0; $i < @freq; $i += 2) { + $expr .= "(\$f0 >= $freq[$i] && \$f0 <= $freq[$i+1]) ||"; + } + chop $expr; + chop $expr; + $expr .= ")"; } - chop $expr; - chop $expr; - $expr .= ")"; - } - print "expr: $expr from: $from to: $to fromday: $fromday today: $today\n"; +# print "expr: $expr from: $from to: $to fromday: $fromday today: $today\n"; - # now do the search - my @res = Spot::search($expr, $fromday, $today, $from, $to); - my $ref; - my @dx; - foreach $ref (@res) { - @dx = @$ref; - push @out, Spot::formatl(@dx); - } + # now do the search + my @res = Spot::search($expr, $fromday, $today, $from, $to); + my $ref; + my @dx; + foreach $ref (@res) { + @dx = @$ref; + push @out, Spot::formatl(@dx); + } } else { - @out = $self->msg('e4'); + @out = $self->msg('e4'); } return (1, @out); diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm index 153c70e9..8bd2c36f 100644 --- a/perl/DXCluster.pm +++ b/perl/DXCluster.pm @@ -261,7 +261,9 @@ sub update_users { my $self = shift; my $count = shift; - $users -= $self->{users}; + $count = 0 unless $count; + + $users -= $self->{users} if $self->{users}; if ((keys %{$self->{list}})) { $self->{users} = (keys %{$self->{list}}); } else { diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 0f802d89..1c54424e 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -199,20 +199,25 @@ sub run_cmd ($path, $fcmd) = search($main::localcmd, $cmd, "pl"); ($path, $fcmd) = search($main::cmd, $cmd, "pl") if !$path || !$fcmd; - dbg('command', "path: $cmd cmd: $fcmd"); + if ($path && $cmd) { + dbg('command', "path: $cmd cmd: $fcmd"); - my $package = find_cmd_name($path, $fcmd); - @ans = (0) if !$package ; - - if ($package) { - dbg('command', "package: $package"); + my $package = find_cmd_name($path, $fcmd); + @ans = (0) if !$package ; - my $c = qq{ \@ans = $package(\$self, \$args) }; - dbg('eval', "cluster cmd = $c\n"); - eval $c; - if ($@) { - @ans = (0, "Syserr: Eval err cached $package\n$@"); + if ($package) { + dbg('command', "package: $package"); + + my $c = qq{ \@ans = $package(\$self, \$args) }; + dbg('eval', "cluster cmd = $c\n"); + eval $c; + if ($@) { + @ans = (0, "Syserr: Eval err cached $package\n$@"); + } } + } else { + dbg('command', "cmd: $cmd not found"); + @ans = (0); } } } @@ -467,12 +472,12 @@ sub find_cmd_name { # return if we can't find it $errstr = undef; - if (undef $mtime) { + unless (defined $mtime) { $errstr = DXM::msg('e1'); return undef; } - if(defined $Cache{$package}{mtime} && $Cache{$package}{mtime } <= $mtime) { + if(defined $Cache{$package}->{mtime} && $Cache{$package}->{mtime } <= $mtime) { #we have compiled this subroutine already, #it has not been updated on disk, nothing left to do #print STDERR "already compiled $package->handler\n"; @@ -510,7 +515,7 @@ sub find_cmd_name { delete_package($package); } else { #cache it unless we're cleaning out each time - $Cache{$package}{mtime} = $mtime; + $Cache{$package}->{'mtime'} = $mtime; } } diff --git a/perl/DXLog.pm b/perl/DXLog.pm index c6994137..dde72302 100644 --- a/perl/DXLog.pm +++ b/perl/DXLog.pm @@ -66,9 +66,6 @@ sub open if (defined $mode) { my $dir = "$self->{prefix}/$year"; mkdir($dir, 0777) if ! -e $dir; - $self->{mode} = $mode; - } else { - delete $self->{mode}; } $self->{fn} = sprintf "$self->{prefix}/$year/%02d", $thing if $self->{'sort'} eq 'm'; @@ -76,6 +73,8 @@ sub open $self->{fn} .= ".$self->{suffix}" if $self->{suffix}; $mode = 'r' if !$mode; + $self->{mode} = $mode; + my $fh = new FileHandle $self->{fn}, $mode; return undef if !$fh; $fh->autoflush(1) if $mode ne 'r'; # make it autoflushing if writable @@ -163,7 +162,6 @@ sub close my $self = shift; undef $self->{fh}; # close the filehandle delete $self->{fh}; - delete $self->{mode}; } # log something in the system log diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 262a4155..80895a55 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -5,7 +5,12 @@ # Copyright (c) 1998 Dirk Koopman G1TLH # # $Id$ -# +# +# +# Notes for implementors:- +# +# PC28 field 11 is the RR required flag +# PC28 field 12 is a VIA routing (ie it is a node call) package DXMsg; diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index 9a782960..a1dca223 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -41,7 +41,7 @@ sub pc11 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); + return sprintf "PC11^%.1f^$dxcall^%s^%s^$text^$mycall^$main::mycall^$hops^~", $freq, cldate($t), ztime($t); } # create an announce message diff --git a/perl/Geomag.pm b/perl/Geomag.pm index 3ee01361..1a118fe0 100644 --- a/perl/Geomag.pm +++ b/perl/Geomag.pm @@ -161,7 +161,7 @@ sub print \$count++; next if \$count < \$from; push \@out, print_item(\$ref); - last LOOP if \$count >= \$to; # stop after n + last if \$count >= \$to; # stop after n } } ); @@ -179,6 +179,7 @@ LOOP: } eval $eval; # do the search on this file return ("Spot search error", $@) if $@; + last if $count >= $to; # stop after n } $fh = $fp->openprev(); # get the next file last if !$fh; -- 2.34.1