]> dxcluster.net Git - spider.git/blob - perl/create_qsl.pl
tidy the Local.pm changes
[spider.git] / 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