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