See also SHOW/WM7D for an alternative.
+=== 0^SHOW/QSL <callsign>^Show any QSL info gathered from spots
+The node collects information from the comment fields in spots (things
+like 'VIA EA7WA' or 'QSL-G1TLH') and stores these in a database.
+
+This command allows you to interrogate that database and if the callsign
+is found will display the manager(s) that people have spotted. This
+information is NOT reliable, but it is normally reasonably accurate if
+it is spotted enough times.
+
+For example:-
+
+ sh/qsl 4k9w
+
+You can check the raw input spots yourself with:-
+
+ sh/dx 4k9w qsl
+
+This gives you more background information.
+
=== 9^SHOW/REGISTERED [<prefix>]^Show the registered users
=== 0^SHOW/ROUTE <callsign> ...^Show the route to the callsign
--- /dev/null
+#
+# load the QSL file after changing it
+#
+my $self = shift;
+return (1, $self->msg('e5')) if $self->priv < 9;
+my $r = QSL::init(1);
+return (1, $r ? $self->msg('ok') : $self->msg('e2', "$!"));
my ($self, $line) = @_;
return (1, $self->msg('e5')) unless $self->priv >= 1;
-use DB_File;
-
my @call = map {uc $_} split /\s+/, $line;
my @out;
my $count;
--- /dev/null
+#
+# Display QSL information from the local database
+#
+# Copyright (c) 2003 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @call = split /\s+/, uc $line;
+my @out;
+
+$DB::single=1;
+
+return (1, $self->msg('db3', 'QSL')) unless $QSL::dbm;
+
+push @out, $self->msg('qsl1');
+foreach my $call (@call) {
+ my $q = QSL::get($call);
+ if ($q) {
+ my $c = $call;
+ for (@{$q->[1]}) {
+ push @out, sprintf "%-14s %-10s %4d %s %s", $c, $_->[0], $_->[1], cldatetime($_->[2]), $_->[3];
+ $c = "";
+ }
+ } else {
+ push @out, $self->msg('db2', $call, 'QSL');
+ }
+}
+
+return (1, @out);
use Internet;
use Script;
use Net::Telnet;
+use QSL;
+use DB_File;
use strict;
use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug $maxbadcount);
qrashe1 => 'Please enter a QRA locator, eg sh/qra JO02LQ or sh/qra JO02LQ IO93NS',
qrae2 => 'Don\'t recognise \"$_[0]\" as a QRA locator (eg JO02LQ)',
qra => 'Your QRA Locator is now \"$_[0]\"',
+ qsl1 => 'Call Manager Times Last Time Seen De',
rcmdo => 'RCMD \"$_[0]\" sent to $_[1]',
read1 => 'Sorry, no new messages for you',
read2 => 'Msg $_[0] not found',
--- /dev/null
+#!/usr/bin/perl -w
+#
+# Local 'autoqsl' module for DXSpider
+#
+# Copyright (c) 2003 Dirk Koopman G1TLH
+#
+
+package QSL;
+
+use strict;
+use DXVars;
+use DXUtil;
+use DB_File;
+use DXDebug;
+use Storable qw(nfreeze thaw);
+
+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($qslfn $dbm);
+$qslfn = 'qsl';
+$dbm = undef;
+
+sub init
+{
+ my $mode = shift;
+ my $ufn = "$main::root/data/$qslfn.v1";
+
+ my %u;
+ if ($mode) {
+ $dbm = tie (%u, 'DB_File', $ufn, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open qsl file: $qslfn ($!)";
+ } else {
+ $dbm = tie (%u, 'DB_File', $ufn, O_RDONLY, 0666, $DB_BTREE) or confess "can't open qsl file: $qslfn ($!)";
+ }
+ return $dbm;
+}
+
+sub finish
+{
+ undef $dbm;
+}
+
+sub new
+{
+ my ($pkg, $call) = @_;
+ return bless [uc $call, []], $pkg;
+}
+
+# the format of each entry is [manager, times found, last time]
+sub update
+{
+ my $self = shift;
+ my $line = shift;
+ my $t = shift;
+ my $by = shift;
+
+ my @tok = map {/^BUR/ || is_callsign($_) ? $_ : ()} split(/\b/, uc $line);
+ foreach my $man (@tok) {
+ $man = 'BUREAU' if $man =~ /^BUR/;
+ my ($r) = grep {$_->[0] eq $man} @{$self->[1]};
+ if ($r) {
+ $r->[1]++;
+ if ($t > $r->[2]) {
+ $r->[2] = $t;
+ $r->[3] = $by;
+ }
+ } else {
+ $r = [$man, 1, $t, $by];
+ push @{$self->[1]}, $r;
+ }
+ }
+ $self->put;
+}
+
+sub get
+{
+ my $key = uc shift;
+ return undef unless $dbm;
+ my $value;
+
+ my $r = $dbm->get($key, $value);
+ return undef if $r;
+ return thaw($value);
+}
+
+sub put
+{
+ my $self = shift;
+ my $key = $self->[0];
+ my $value = nfreeze($self);
+ $dbm->del($key);
+ $dbm->put($key, $value);
+}
+
+1;
use Prefix;
use DXDupe;
use Data::Dumper;
+use QSL;
use strict;
} else {
$vhfspots++;
}
+ if ($_[3] =~ /(?:QSL|VIA)/i) {
+ my $q = QSL::get($_[1]) || new QSL $_[1];
+ $q->update($_[3], $_[2], $_[4]);
+ }
}
# search the spot database for records based on the field no and an expression
use Mrtg;
use USDB;
use UDPMsg;
+use QSL;
use Data::Dumper;
use IO::File;
use vars qw($VERSION $BRANCH $build $branch);
$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0));
-$main::build += 6; # add an offset to make it bigger than last system
+$main::build += 5; # add an offset to make it bigger than last system
$main::build += $VERSION;
$main::branch += $BRANCH;
# starting local stuff
dbg("doing local initialisation ...");
+QSL::init(1) or die "Cannot open local QSL database";
eval {
Local::init();
};
+++ /dev/null
-#!/usr/bin/perl
-#
-# Implement a 'GO' database list
-#
-# Copyright (c) 2003 Dirk Koopman G1TLH
-#
-# $Id$
-#
-
-# search local then perl directories
-BEGIN {
- use vars qw($root);
-
- # root of directory tree for this system
- $root = "/spider";
- $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
-
- unshift @INC, "$root/perl"; # this IS the right way round!
- unshift @INC, "$root/local";
-}
-
-use strict;
-
-use IO::File;
-use DXVars;
-use DXUtil;
-use Spot;
-use DXDb;
-
-use vars qw($end $lastyear $lastday);
-
-$end = 0;
-$SIG{TERM} = $SIG{INT} = sub { $end++ };
-
-my $qslfn = "localqsl";
-$lastyear = 0;
-$lastday = 0;
-
-$main::systime = time;
-
-DXDb::load();
-my $db = DXDb::getdesc($qslfn);
-unless ($db) {
- DXDb::new($qslfn);
- DXDb::load();
- $db = DXDb::getdesc($qslfn);
-}
-die "cannot load $qslfn $!" unless $db;
-
-# find start point (if any)
-my $statefn = "$root/data/$qslfn.state";
-my $s = readfilestr($statefn);
-eval $s if $s;
-
-my $base = "$root/data/spots";
-
-opendir YEAR, $base or die "$base $!";
-foreach my $year (sort readdir YEAR) {
- next if $year =~ /^\./;
- next unless $year ge $lastyear;
-
- my $baseyear = "$base/$year";
- opendir DAY, $baseyear or die "$baseyear $!";
- foreach my $day (sort readdir DAY) {
- next unless $day =~ /(\d+)\.dat$/;
- my $dayno = $1 + 0;
- next unless $dayno >= $lastday;
-
- my $fn = "$baseyear/$day";
- my $f = new IO::File $fn or die "$fn ($!)";
- print "doing: $fn\n";
- while (<$f>) {
- if (/(QSL|VIA)/i) {
- my ($freq, $call, $t, $comment, $by, @rest) = split /\^/;
- my $value = $db->getkey($call) || "";
- my $newvalue = update($value, $call, $t, $comment, $by);
- if ($newvalue ne $value) {
- $db->putkey($call, $newvalue);
- }
- }
- }
- $f->close;
- $f = new IO::File ">$statefn" or die "cannot open $statefn $!";
- print $f "\$lastyear = $year; \$lastday = $dayno;\n";
- $f->close;
- }
-}
-
-DXDb::closeall();
-exit(0);
-
-sub update
-{
- my ($line, $call, $t, $comment, $by) = @_;
- my @lines = split /\n/, $line;
- my @in;
-
- # decode the lines
- foreach my $l (@lines) {
- my ($date, $time, $oby, $ocom) = $l =~ /^(\s?\S+)\s+(\s?\S+)\s+de\s+(\S+):\s+(.*)$/;
- if ($date) {
- my $ot = cltounix($date, $time);
- push @in, [$ot, $oby, $ocom];
- }
- }
-
- # is this newer than the earliest one?
- if (@in && $in[0]->[0] < $t) {
- @in = grep {$_->[1] ne $by} @in;
- }
- $comment =~ s/://g;
- unshift @in, [$t, $by, $comment] if grep /^bur/i || is_callsign(uc $_), split(/\b/, $comment);
- pop @in, if @in > 10;
- return join "\n", (map {(cldatetime($_->[0]) . " de $_->[1]: $_->[2]")} @in);
-}
-
projects / spider.git / commitdiff