perl/create_qsl.pl

   1 #!/usr/bin/env 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 SysVar;
  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 "$data/qsl.v1";
  40 unlink "$local_data/qsl.v1";
  41
  42 QSL::init(1) or die "cannot open QSL file";
  43
  44 my $base = localdata("spots");
  45
  46 opendir YEAR, $base or die "$base $!";
  47 foreach my $year (sort readdir YEAR) {
  48         next if $year =~ /^\./;
  49
  50         my $baseyear = "$base/$year";
  51         opendir DAY,  $baseyear or die "$baseyear $!";
  52         foreach my $day (sort readdir DAY) {
  53                 next unless $day =~ /(\d+)\.dat$/;
  54                 my $dayno = $1 + 0;
  55
  56                 my $fn = "$baseyear/$day";
  57                 my $f = new IO::File $fn  or die "$fn ($!)";
  58                 print "doing: $fn\n";
  59                 while (<$f>) {
  60                         last if $end;
  61                         if (/(QSL|VIA)/i) {
  62                                 my ($freq, $call, $t, $comment, $by, @rest) = split /\^/;
  63                                 my $q = QSL::get($call) || new QSL $call;
  64                                 $q->update($comment, $t, $by);
  65                                 $lasttime = $t;
  66                         }
  67                 }
  68                 $f->close;
  69                 last if $end;
  70         }
  71         last if $end;
  72 }
  73
  74 QSL::finish();
  75
  76 exit(0);
  77
  78