Allow synonyms for localhost

[spider.git] / perl / create_prefix.pl

diff --git a/perl/create_prefix.pl b/perl/create_prefix.pl
index daf4a09e409171cb1433b068aa9aa9a8c1d218c6..72df12c1418fc821ca793f7b9c7fac1583f529e7 100755 (executable)
--- a/perl/create_prefix.pl
+++ b/perl/create_prefix.pl
@@ -6,7 +6,7 @@
 #
 #
 
-require 5.004;
+use 5.10.1;
 
 # search local then perl directories
 BEGIN {
@@ -18,12 +18,15 @@ BEGIN {
 
        unshift @INC, "$root/perl";     # this IS the right way round!
        unshift @INC, "$root/local";
+       $data = "$root/data";
 }
 
+use DXVars;
 use SysVar;
 
 use Data::Dumper;
 use DXUtil;
+use DXBearing;
 
 use strict;
 
@@ -33,18 +36,26 @@ my %locn = ();                                              # the inverse of the above
 my %pre = ();                                          # the prefix hash
 my %pren = ();                                         # the inverse
 
-if (@ARGV && $ARVG[0] =~ /^--system$/) {
+my $prefix;
+my $system;
+
+if (@ARGV && $ARGV[0] =~ /^-?-?syst?e?m?$/) {
        $prefix = $main::data;
+       ++$system;
        shift;
+       say "create_prefix.pl: creating SYSTEM prefix files";   
 } else {
-       $prefix = $main:local_data;
+       $prefix = $main::local_data;
+       say "create_prefix.pl: creating LOCAL prefix files";    
 }
 
-# open the input file
-my $ifn = $ARGV[0] if $ARGV[0];
+my $ifn;
 
-$ifn = "$prefix/wpxloc.raw" if !$ifn;
-open (IN, $ifn) or die "can't open $ifn ($!)";
+$ifn = $system ? "$main::data/wpxloc.raw" : "$prefix/wpxloc.raw";
+unless (open (IN, $ifn)) {
+       $ifn = "$main::data/wpxloc.raw";
+       open(IN, $ifn) or die "can't open $ifn ($!)";
+}
 
 # first pass, find all the 'master' location records
 while (<IN>) {
@@ -104,10 +115,17 @@ close(IN);
 #print Data::Dumper->Dump([\%pre, \%locn], [qw(pre locn)]);
 
 # now open the cty.dat file if it is there
+my $r;
+$ifn = $system ? "$main::data/cty.dat" : "$prefix/cty.dat";
+unless ($r = open (IN, $ifn)) {
+       $ifn = "$main::data/cty.dat";
+       $r = open(IN, $ifn);
+}
+
 my @f;
 my @a;
 $line = 0;
-if (open(IN, "$prefix/cty.dat")) {
+if ($r) {
        my $state = 0;
        while (<IN>) {
                $line++;
@@ -156,13 +174,15 @@ foreach my $l (sort {$a <=> $b} keys %locn) {
        $longd = 0-$longd if (uc $longl) eq 'W'; 
        $latd += ($latm/60);
        $latd = 0-$latd if (uc $latl) eq 'S';
+       my $qra = DXBearing::lltoqra($latd, $longd);
        print OUT " name => '$name',";
        print OUT " dxcc => $dxcc,";
        print OUT " itu => $itu,";
        print OUT " cq => $cq,";
        print OUT " utcoff => $utcoff,";
        print OUT " lat => $latd,";
-       print OUT " long => $longd";
+       print OUT " long => $longd,";
+       print OUT " qra => '$qra'";
        print OUT " }, 'Prefix'),\n";
 }
 print OUT ");\n\n";