X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcreate_prefix.pl;h=411b2cb84113b96d573f6c8b832b39215e5c9f45;hb=894198b41542dd145606f9cb3feb5b4b2cd96406;hp=a2b3c374210cccde478f048baa421e5ea2f24270;hpb=70dbd742db4241e97496db69e89160ec573a5949;p=spider.git diff --git a/perl/create_prefix.pl b/perl/create_prefix.pl index a2b3c374..411b2cb8 100755 --- a/perl/create_prefix.pl +++ b/perl/create_prefix.pl @@ -3,7 +3,7 @@ # # Copyright (c) - Dirk Koopman G1TLH # -# $Id$ +# # require 5.004; @@ -16,6 +16,7 @@ BEGIN { unshift @INC, "$root/perl"; # this IS the right way round! unshift @INC, "$root/local"; + $data = "$root/data"; } use DXVars; @@ -90,33 +91,6 @@ close(IN); #print Data::Dumper->Dump([\%pre, \%locn], [qw(pre locn)]); -# now open the rsgb.cty file and process that again the prefix file we have -open(IN, "$main::data/rsgb.cty") or die "Can't open $main::data/rsgb.cty ($!)"; -$line = 0; -while () { - $line++; - next if /^\s*#/; - next if /^\s*$/; - my $l = $_; - chomp; - my @f = split /:\s+|;/; - my $p = uc $f[4]; - my $ref = $pre{$p}; - if ($ref) { - # split up the alias string - my @alias = split /=/, $f[5]; - my $a; - foreach $a (@alias) { - next if $a eq $p; # ignore if we have it already - my $nref = $pre{$a}; - $pre{$a} = $ref if !$nref; # copy the original ref if new - } - } else { - print "line $line: unknown prefix '$p' on $l in rsgb.cty\n"; - } -} -close IN; - # now open the cty.dat file if it is there my @f; my @a; @@ -140,7 +114,7 @@ if (open(IN, "$main::data/cty.dat")) { $state = 0; s/[,;]$//; push @a, split /\s*,/; - next if $f[7] =~ /^\*/; # ignore callsigns starting '*' + $f[7] =~ s/^\*\s*//; # remove any preceeding '*' before a callsign ct($_, uc $f[7], @a) if @a; } else { s/,$//; @@ -218,6 +192,7 @@ sub ct my ($itu) = $a =~ /(\(\d+\))/; $a =~ s/(\(\d+\))//g; my ($cq) = $a =~ /(\[\d+\])/; $a =~ s/(\[\d+\])//g; my ($lat, $long) = $a =~ m{(<[-+\d.]+/[-+\d.]+>)}; $a =~ s{(<[-+\d.]+/[-+\d.]+>)}{}g; + my ($cont) = $a =~ /(\{[A-Z]{2}\})/; $a =~ s/(\{[A-Z]{2}\})//g; unless ($a) { print "line $line: blank prefix on $l in cty.dat\n";