2 # a program to create a prefix file from a wpxloc.raw file
4 # Copyright (c) - Dirk Koopman G1TLH
11 %loc = (); # the location unique hash
12 $nextloc = 1; # the next location number
13 %locn = (); # the inverse of the above
14 %pre = (); # the prefix hash
15 %pren = (); # the inverse
18 $ifn = $ARGV[0] if $ARGV[0];
19 $ifn = "$data/wpxloc.raw" if !$fn;
20 open (IN, $ifn) or die "can't open $ifn ($!)";
22 # first pass, find all the 'master' records
24 next if /^\!/; # ignore comment lines
26 @f = split; # get each 'word'
27 next if @f == 0; # ignore blank lines
29 if ($f[14] eq '@' || $f[15] eq '@') {
30 $locstr = join ' ', @f[1..13];
32 $loc = addloc($locstr) if !$loc;
36 #foreach $loc (sort {$a <=> $b;} keys %locn) {
37 # print "loc: $loc data: $locn{$loc}\n";
40 # go back to the beginning and this time add prefixes (adding new location entries, if required)
44 next if /^\!/; # ignore comment lines
46 @f = split; # get each 'word'
47 next if @f == 0; # ignore blank lines
49 $locstr = join ' ', @f[1..13];
51 $loc = addloc($locstr) if !$loc;
53 @prefixes = split /,/, $f[0];
54 foreach $p (@prefixes) {
59 for ($i = 0; $i < 9; ++$i) {
63 $ref = addpre($t) if !$ref;
64 next if grep $loc, @{$ref}; # no dups!
69 $ref = addpre($p) if !$ref;
70 next if grep $loc, @{$ref}; # no dups!
78 # now open the rsgb.cty file and process that again the prefix file we have
79 open(IN, "$data/rsgb.cty") or die "Can't open $data/rsgb.cty ($!)";
86 # split up the alias string
87 my @alias = split /=/, $f[5];
90 next if $a eq $p; # ignore if we have it already
92 $pre{$a} = $ref if !$nref; # copy the original ref if new
95 print "unknown prefix $p\n";
99 open(OUT, ">$data/prefix_data.pl") or die "Can't open $data/prefix_data.pl ($!)";
101 print OUT "%prefix_loc = (\n";
102 foreach $l (sort {$a <=> $b} keys %locn) {
103 print OUT " $l => {";
104 my ($name, $dxcc, $itu, $cq, $utcoff, $latd, $latm, $lats, $latl, $longd, $longm, $longs, $longl) = split /\s+/, $locn{$l};
106 $longd += ($longm/60);
107 $longd = 0-$longd if (uc $longl) eq 'W';
109 $latd = 0-$latd if (uc $latl) eq 'S';
110 print OUT " name => '$name',";
111 print OUT " dxcc => $dxcc,";
112 print OUT " itu => $itu,";
113 print OUT " utcoff => $utcoff,";
114 print OUT " lat => $latd,";
115 print OUT " long => $longd";
120 print OUT "%prefix = (\n";
121 foreach $k (sort keys %pre) {
122 print OUT " '$k' => [";
123 my @list = @{$pre{$k}};
130 print OUT "$str ],\n";
146 $locstr =~ s/\'/\\'/g;
147 my $loc = $loc{$locstr} = $nextloc++;
148 $locn{$loc} = $locstr;