perl/create_qsl.pl

   1 #!/usr/bin/perl
   2 #
   3 # Implement a 'GO' database list
   4 #
   5 # Copyright (c) 2003 Dirk Koopman G1TLH
   6 #
   7 #
   8 #
   9
  10 # search local then perl directories
  11 BEGIN {
  12         use vars qw($root);
  13
  14         # root of directory tree for this system
  15         $root = "/spider";
  16         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
  17
  18         unshift @INC, "$root/perl";     # this IS the right way round!
  19         unshift @INC, "$root/local";
  20 }
  21
  22 use strict;
  23
  24 use IO::File;
  25 use DXVars;
  26 use DXUtil;
  27 use Spot;
  28 use QSL;
  29
  30 use vars qw($end $lastyear $lastday $lasttime);
  31
  32 $end = 0;
  33 $SIG{TERM} = $SIG{INT} = sub { $end++ };
  34
  35 my $qslfn = "qsl";
  36
  37 $main::systime = time;
  38
  39 unlink "$root/data/qsl.v1";
  40
  41 QSL::init(1) or die "cannot open QSL file";
  42
  43 my $base = "$root/data/spots";
  44
  45 opendir YEAR, $base or die "$base $!";
  46 foreach my $year (sort readdir YEAR) {
  47         next if $year =~ /^\./;
  48
  49         my $baseyear = "$base/$year";
  50         opendir DAY,  $baseyear or die "$baseyear $!";
  51         foreach my $day (sort readdir DAY) {
  52                 next unless $day =~ /(\d+)\.dat$/;
  53                 my $dayno = $1 + 0;
  54
  55                 my $fn = "$baseyear/$day";
  56                 my $f = new IO::File $fn  or die "$fn ($!)";
  57                 print "doing: $fn\n";
  58                 while (<$f>) {
  59                         last if $end;
  60                         if (/(QSL|VIA)/i) {
  61                                 my ($freq, $call, $t, $comment, $by, @rest) = split /\^/;
  62                                 my $q = QSL::get($call) || new QSL $call;
  63                                 $q->update($comment, $t, $by);
  64                                 $lasttime = $t;
  65                         }
  66                 }
  67                 $f->close;
  68                 last if $end;
  69         }
  70         last if $end;
  71 }
  72
  73 QSL::finish();
  74
  75 exit(0);
  76
  77