X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUtil.pm;h=b9afba12d29dba40bfea78cde38b570642551d70;hb=abbcfa7500858a2eba4135b0af5db9f3fca8d68e;hp=b58a4528d5649bc60df8dbcd23e892e58bde30b5;hpb=c94ff1bf2cbe16ed59c5b273c7f6730fd7314cab;p=spider.git diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index b58a4528..b9afba12 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -24,7 +24,7 @@ require Exporter; @EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf parray parraypairs phex phash shellregex readfilestr writefilestr filecopy ptimelist - print_all_fields cltounix unpad is_callsign is_long_callsign is_latlong + print_all_fields cltounix unpad is_callsign is_latlong is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem is_prefix dd is_ipaddr $pi $d2r $r2d localdata localdata_mv ); @@ -381,30 +381,20 @@ sub unpad # check that a field only has callsign characters in it sub is_callsign { - return $_[0] =~ m!^(?:[A-Z]{1,2}\d+ | \d[A-Z]{1,2}\d+) # basic prefix - (?:/(?:[A-Z]{1,2}\d+ | \d[A-Z]{1,2}\d+))? # / another one (possibly) - [A-Z]{1,4} # callsign letters - (?:/(?:[A-Z]{1,2}\d+ | \d[A-Z]{1,2}\d+))? # / another prefix possibly - (?:/[0-9A-Z]{1,2})? # /0-9A-Z+ possibly - (?:-\d{1,2})? # - nn possibly - $!x; -} + return $_[0] =~ m!^ + (?:\d?[A-Z]{1,2}\d*/)? # out of area prefix / + (?:\d?[A-Z]{1,2}\d+) # main prefix one (required) + [A-Z]{1,5} # callsign letters (required) + (?:-(?:\d{1,2}|\#))? # - nn possibly (eg G8BPQ-8) or -# (an RBN spot) + (?:/[0-9A-Z]{1,7})? # / another prefix, callsign or special label (including /MM, /P as well as /EURO or /LGT) possibly + $!x; -# check that a field only has callsign characters in it but has more than the standard 3 callsign letters -sub is_long_callsign -{ - return $_[0] =~ m!^(?:[A-Z]{1,2}\d+ | \d[A-Z]{1,2}\d+) # basic prefix - (?:/(?:[A-Z]{1,2}\d+ | \d[A-Z]{1,2}\d+))? # / another one (possibly) - [A-Z]{1,5} # callsign letters - (?:/(?:[A-Z]{1,2}\d+ | \d[A-Z]{1,2}\d+))? # / another prefix possibly - (?:/[0-9A-Z]{1,2})? # /0-9A-Z+ possibly - (?:-\d{1,2})? # - nn possibly - $!x; + # longest callign allowed is 1X11/1Y11XXXXX-11/XXXXXXX } sub is_prefix { - return $_[0] =~ m!^(?:[A-Z]{1,2}\d+ | \d[A-Z]{1,2}\d+)!x # basic prefix + return $_[0] =~ m!^(?:[A-Z]{1,2}\d+ | \d[A-Z]{1,2}}\d+)!x # basic prefix } @@ -437,7 +427,8 @@ sub is_digits # does it look like a qra locator? sub is_qra { - return $_[0] =~ /^[A-Ra-r][A-Ra-r]\d\d[A-Xa-x][A-Xa-x]$/; + return unless length $_[0] == 4 || length $_[0] == 6; + return $_[0] =~ /^[A-Ra-r][A-Ra-r]\d\d(?:[A-Xa-x][A-Xa-x])?$/; } # does it look like a valid lat/long @@ -449,7 +440,7 @@ sub is_latlong # is it an ip address? sub is_ipaddr { - return $_[0] =~ /^\d+\.\d+\.\d+\.\d+$/ || $_[0] =~ /^[0-9a-f:]+$/; + return $_[0] =~ /^\d+\.\d+\.\d+\.\d+$/ || $_[0] =~ /^[0-9a-f:,]+$/; } # insert an item into a list if it isn't already there returns 1 if there 0 if not @@ -484,8 +475,10 @@ sub localdata my $tfn; if (-e "$main::local_data") { - $tfn = "main::local_data/$ifn"; - if (-e $tfn && -M $tfn < -M $ofn) { + $tfn = "$main::local_data/$ifn"; + if (-e $tfn && -e $ofn) { + $ofn = $tfn if -M $tfn < -M $ofn; + } elsif (-e $tfn) { $ofn = $tfn; } }