3 # Implement a 'GO' database list
5 # Copyright (c) 2003 Dirk Koopman G1TLH
10 # search local then perl directories
14 # root of directory tree for this system
16 $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
18 unshift @INC, "$root/perl"; # this IS the right way round!
19 unshift @INC, "$root/local";
30 use vars qw($end $lastyear $lastday);
33 $SIG{TERM} = $SIG{INT} = sub { $end++ };
35 my $qslfn = "localqsl";
39 $main::systime = time;
42 my $db = DXDb::getdesc($qslfn);
46 $db = DXDb::getdesc($qslfn);
48 die "cannot load $qslfn $!" unless $db;
50 # find start point (if any)
51 my $statefn = "$root/data/$qslfn.state";
52 my $s = readfilestr($statefn);
55 my $base = "$root/data/spots";
57 opendir YEAR, $base or die "$base $!";
58 foreach my $year (sort readdir YEAR) {
59 next if $year =~ /^\./;
60 next unless $year ge $lastyear;
62 my $baseyear = "$base/$year";
63 opendir DAY, $baseyear or die "$baseyear $!";
64 foreach my $day (sort readdir DAY) {
65 next unless $day =~ /(\d+)\.dat$/;
67 next unless $dayno >= $lastday;
69 my $fn = "$baseyear/$day";
70 my $f = new IO::File $fn or die "$fn ($!)";
74 my ($freq, $call, $t, $comment, $by, @rest) = split /\^/;
75 my $value = $db->getkey($call) || "";
76 my $newvalue = update($value, $call, $t, $comment, $by);
77 if ($newvalue ne $value) {
78 $db->putkey($call, $newvalue);
83 $f = new IO::File ">$statefn" or die "cannot open $statefn $!";
84 print $f "\$lastyear = $year; \$lastday = $dayno;\n";
94 my ($line, $call, $t, $comment, $by) = @_;
95 my @lines = split /\n/, $line;
99 foreach my $l (@lines) {
100 my ($date, $time, $oby, $ocom) = $l =~ /^(\s?\S+)\s+(\s?\S+)\s+de\s+(\S+):\s+(.*)$/;
102 my $ot = cltounix($date, $time);
103 push @in, [$ot, $oby, $ocom];
107 # is this newer than the earliest one?
108 if (@in && $in[0]->[0] < $t) {
109 @in = grep {$_->[1] ne $by} @in;
112 unshift @in, [$t, $by, $comment] if grep /^bur/i || is_callsign(uc $_), split(/\b/, $comment);
113 pop @in, if @in > 10;
114 return join "\n", (map {(cldatetime($_->[0]) . " de $_->[1]: $_->[2]")} @in);