]> gb7djk.dxcluster.net Git - spider.git/blobdiff - perl/create_localqsl.pl
added builtin sh.qsl command
[spider.git] / perl / create_localqsl.pl
diff --git a/perl/create_localqsl.pl b/perl/create_localqsl.pl
deleted file mode 100755 (executable)
index e3f447f..0000000
+++ /dev/null
@@ -1,116 +0,0 @@
-#!/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);
-}
-