remove all filtering (but retain ephemeral dup checking).
2. Improve format checking in latlong and qra locators.
3. Sort sh/st so that sh/st by itself displays only the local call not the
whole lot (all 17000+ users records in my case). SH/ST ALL does this.
+17Aug01=======================================================================
+1. Sort out PC41 handling to include type 5 records for QRA locators and also
+remove all filtering (but retain ephemeral dup checking).
+2. Improve format checking in latlong and qra locators.
+3. Sort sh/st so that sh/st by itself displays only the local call not the
+whole lot (all 17000+ users records in my case). SH/ST ALL does this.
16Aug01=======================================================================
1. send a forward/opernam for a logged in user once a month (when they next
login).
SH/SAT AO-10
SH/SAT FENGYUN1 12 2
+=== 6^SHOW/STATION ALL [<regex>]^Show list of users in the system
+=== 0^SHOW/STATION [<callsign> ..]^Show information about a callsign
+Show the information known about a callsign and whether (and where)
+that callsign is connected to the cluster.
+
+ SH/ST G1TLH
+
+If no callsign is given then show the information for yourself.
+
=== 0^SHOW/SUN [<prefix>|<callsign>]^Show sun rise and set times
Show the sun rise and set times for a (list of) prefixes or callsigns,
together with the azimuth and elevation of the sun currently at those
my $lat = $ref->lat;
my $long = $ref->long;
my $node = $ref->homenode;
+ my $qra = $ref->qra;
my $latlong = DXBearing::lltos($lat, $long) if $lat && $long;
if ($name) {
my $l = DXProt::pc41($DXProt::me, $call, 1, $name);
DXProt::eph_dup($l);
DXProt::broadcast_all_ak1a($l, $DXProt::me) ;
}
+ if ($qra) {
+ my $l = DXProt::pc41($call, 5, $qra);
+ DXProt::eph_dup($l);
+ DXProt::broadcast_all_ak1a($l, $DXProt::me) ;
+ }
}
}
$line =~ s/\s+$//;
return (1, $self->msg('loce1')) if !$line;
-return (1, $self->msg('loce3', uc $line)) if DXBearing::is_qra($line);
-return (1, $self->msg('loce2', $line)) unless $line =~ /\d+ \d+ [NnSs] \d+ \d+ [EeWw]/o;
+return (1, $self->msg('loce3', uc $line)) if is_qra($line);
+return (1, $self->msg('loce2', $line)) unless is_latlong($line);
$user = DXUser->get_current($call);
if ($user) {
$line = uc $line;
my ($lat, $long) = DXBearing::stoll($line);
- $user->lat($lat);
- $user->long($long);
- my $s = DXProt::pc41($call, 3, $line);
- DXProt::eph_dup($s);
- DXProt::broadcast_all_ak1a($s, $DXProt::me) ;
- unless ($user->qra && DXBearing::is_qra($user->qra) ) {
- my $qra = DXBearing::lltoqra($lat, $long);
+ my $oldlat = $user->lat || 0;
+ my $oldlong = $user->long || 0;
+ if ($oldlat != $lat || $oldlong != $long) {
+ $user->lat($lat);
+ $user->long($long);
+ my $l = DXBearing::lltos($lat, $long);
+ my $s = DXProt::pc41($call, 3, $l);
+ DXProt::eph_dup($s);
+ DXProt::broadcast_all_ak1a($s, $DXProt::me) ;
+ }
+ my $qra = DXBearing::lltoqra($lat, $long);
+ my $oldqra = $user->qra || "";
+ if ($oldqra ne $qra) {
$user->qra($qra);
+ my $s = DXProt::pc41($call, 5, $qra);
+ DXProt::eph_dup($s);
+ DXProt::broadcast_all_ak1a($s, $DXProt::me);
}
$user->put();
$line =~ s/\s+$//;
return (1, $self->msg('qrae1')) if !$line;
-return (1, $self->msg('qrae2', $line)) unless DXBearing::is_qra($line);
+return (1, $self->msg('qrae2', $line)) unless is_qra($line);
$user = DXUser->get_current($call);
if ($user) {
- $line = uc $line;
- $user->qra($line);
- if (!$user->lat && !$user->long) {
- my ($lat, $long) = DXBearing::qratoll($line);
+ my $qra = uc $line;
+ my $oldqra = $user->qra || "";
+ if ($oldqra ne $qra) {
+ $user->qra($qra);
+ my $s = DXProt::pc41($call, 5, $qra);
+ DXProt::eph_dup($s);
+ DXProt::broadcast_all_ak1a($s, $DXProt::me);
+ }
+ my ($lat, $long) = DXBearing::qratoll($qra);
+ my $oldlat = $user->lat || 0;
+ my $oldlong = $user->long || 0;
+ if ($oldlat != $lat || $oldlong != $long) {
$user->lat($lat);
$user->long($long);
- my $s = DXBearing::lltos($lat, $long);
- my $l = DXProt::pc41($call, 3, $s);
- DXProt::eph_dup($l);
- DXProt::broadcast_all_ak1a($l, $DXProt::me) ;
+ my $l = DXBearing::lltos($lat, $long);
+ my $s = DXProt::pc41($call, 3, $l);
+ DXProt::eph_dup($s);
+ DXProt::broadcast_all_ak1a($s, $DXProt::me) ;
}
$user->put();
my ($self, $line) = @_;
return (1, $self->msg('e5')) if $self->priv < 9;
-
-my $call = $main::mycall;
-my $user;
-
-# remove leading and trailing spaces
-$line =~ s/^\s+//;
-$line =~ s/\s+$//;
-
-return (1, $self->msg('qrae1')) if !$line;
-return (1, $self->msg('qrae2', $line)) unless DXBearing::is_qra($line);
-
-$user = DXUser->get_current($call);
-if ($user) {
- $line = uc $line;
- $user->qra($line);
- if (!$user->lat && !$user->long) {
- my ($lat, $long) = DXBearing::qratoll($line);
- $user->lat($lat);
- $user->long($long);
- my $s = DXBearing::lltos($lat, $long);
- DXProt::broadcast_all_ak1a(DXProt::pc41($call, 3, $s), $DXProt::me);
- }
-
- $user->put();
- return (1, $self->msg('sqra', $line));
-} else {
- return (1, $self->msg('namee2', $call));
-}
+return (1, run_cmd("set/qra $main::mycall"));
$line = uc $line;
# convert a lat/long into a qra locator if we see a pattern looking like a lat/long
-if ($line =~ /^\d+\s+\d+\s*[NS]\s+\d+\s+\d+\s*[EW]/) {
- $line =~ s/(\d)([NSEW])/$1 $2/g;
+if (is_latlong($line)) {
my ($llat, $llong) = DXBearing::stoll(uc $line);
return (1, "QRA $line = " . DXBearing::lltoqra($llat, $llong));
}
# check from qra
my $f = uc $list[0];
$f .= 'MM' if $f =~ /^[A-Z][A-Z]\d\d$/;
-return (1, $self->msg('qrae2', $f)) unless DXBearing::is_qra($f);
+return (1, $self->msg('qrae2', $f)) unless is_qra($f);
($lat, $long) = DXBearing::qratoll($f);
# check to qra
my $l = uc $list[1];
$l .= 'MM' if $l =~ /^[A-Z][A-Z]\d\d$/;
-return (1, $self->msg('qrae2', $l)) unless DXBearing::is_qra($l);
+return (1, $self->msg('qrae2', $l)) unless is_qra($l);
my ($qlat, $qlong) = DXBearing::qratoll($l);
# generate alpha lat/long
my @out;
my $call;
my $seek;
+push @f, $self->call unless @f;
-if (@f == 0) {
- return (1, $self->msg('e6')) if ($self->priv < 5);
+if (@f == 1 && uc $f[0] eq 'ALL') {
+ return (1, $self->msg('e6')) if ($self->priv < 6);
my @calls = DXUser::get_all_calls();
foreach $call (@calls) {
my $ref = DXUser->get_current($call);
return ($n / 180) * $pi;
}
-# does it look like a qra locator?
-sub is_qra
-{
- my $qra = shift;
- return $qra =~ /^[A-Za-z][A-Za-z]\d\d[A-Za-z][A-Za-z]$/o;
-}
-
# calc bearing and distance, with arguments in DEGREES
# home lat/long -> lat/long
# returns bearing (in DEGREES) & distance in KM
# turn a lat long string into floating point lat and long
sub stoll
{
- my ($latd, $latm, $latl, $longd, $longm, $longl) = split /\s+/, shift;
+ my ($latd, $latm, $latl, $longd, $longm, $longl) = $_[0] =~ /(\d{1,2})\s+(\d{1,2})\s*([NnSs])\s+(\d{1,2})\s+(\d{1,2})\s*([EeWw])/;
$longd += ($longm/60);
$longd = 0-$longd if (uc $longl) eq 'W';
my $user = DXUser->get_current($spot[4]);
if ($user) {
my $qra = $user->qra;
- unless ($qra && DXBearing::is_qra($qra)) {
+ unless ($qra && is_qra($qra)) {
my $lat = $user->lat;
my $long = $user->long;
if (defined $lat && defined $long) {
my $call = $field[1];
# input filter if required
- my $ref = Route::get($call) || Route->new($call);
- return unless $self->in_filter_route($ref);
+# my $ref = Route::get($call) || Route->new($call);
+# return unless $self->in_filter_route($ref);
# add this station to the user database, if required
my $user = DXUser->get_current($call);
} elsif ($field[2] == 2) {
$user->qth($field[3]);
} elsif ($field[2] == 3) {
- my ($lat, $long) = DXBearing::stoll($field[3]);
- $user->lat($lat);
- $user->long($long);
- $user->qra(DXBearing::lltoqra($lat, $long)) unless $user->qra && DXBearing::is_qra($user->qra);
+ if (is_latlong($field[3])) {
+ my ($lat, $long) = DXBearing::stoll($field[3]);
+ $user->lat($lat);
+ $user->long($long);
+ $user->qra(DXBearing::lltoqra($lat, $long));
+ } else {
+ dbg('PCPROT: not a valid lat/long') if isdbg('chanerr');
+ return;
+ }
} elsif ($field[2] == 4) {
$user->homenode($field[3]);
+ } elsif ($field[2] == 5) {
+ if (is_qra($field[3])) {
+ my ($lat, $long) = DXBearing::qratoll($field[3]);
+ $user->lat($lat);
+ $user->long($long);
+ $user->qra($field[3]);
+ } else {
+ dbg('PCPROT: not a valid QRA locator') if isdbg('chanerr');
+ return;
+ }
}
$user->lastoper($main::systime); # to cut down on excessive for/opers being generated
$user->put;
@ISA = qw(Exporter);
@EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf
parray parraypairs phex shellregex readfilestr writefilestr
- print_all_fields cltounix unpad is_callsign
- is_freq is_digits is_pctext is_pcflag insertitem deleteitem
+ print_all_fields cltounix unpad is_callsign is_latlong
+ is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem
);
@month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
# check that a field only has callsign characters in it
sub is_callsign
{
- return $_[0] =~ /^(?:[A-Z]{1,2}\d+|\d[A-Z]\d+)[A-Z0-9\/\-]+$/;
+ return $_[0] =~ /^(?:[A-Z]{1,2}\d+|\d[A-Z]\d+)[A-Z]+(?:-\d{1,2}|\/[A-Z0-9]+)?$/;
}
# check that a PC protocol field is valid text
return $_[0] =~ /^[\d]+$/;
}
+# does it look like a qra locator?
+sub is_qra
+{
+ return $_[0] =~ /^[A-Za-z][A-Za-z]\d\d[A-Za-z][A-Za-z]$/o;
+}
+
+# does it look like a valid lat/long
+sub is_latlong
+{
+ return $_[0] =~ /^\s*\d{1,2}\s+\d{1,2}\s*[NnSs]\s+\d{1,2}\s+\d{1,2}\s*[EeWw]\s*$/;
+}
+
# insert an item into a list if it isn't already there returns 1 if there 0 if not
sub insertitem
{
my @today = Julian::unixtoj(time());
my $fh = $fp->open(@today) or die $!;
my $nolines = 1;
-$nolines = shift if $ARGV[0] =~ /^\d+$/;
+$nolines = shift if $ARGV[0] =~ /^-?\d+$/;
+$nolines = abs $nolines if $nolines < 0;
my $exp = join '|', @ARGV;
my @prev;
projects / spider.git / commitdiff