put dx.pl into an explicit handle sub

[spider.git] / perl / DXUtil.pm

diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index 512c30efcc0e35609c3d931f0c20bf172af517ef..b9afba12d29dba40bfea78cde38b570642551d70 100644 (file)
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -8,14 +8,16 @@
 
 package DXUtil;
 
+
 use Date::Parse;
 use IO::File;
 use File::Copy;
 use Data::Dumper;
 
+
 use strict;
 
-use vars qw(@month %patmap @ISA @EXPORT);
+use vars qw(@month %patmap $pi $d2r $r2d @ISA @EXPORT);
 
 require Exporter;
 @ISA = qw(Exporter);
@@ -24,7 +26,7 @@ require Exporter;
                         filecopy ptimelist
              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_prefix dd is_ipaddr $pi $d2r $r2d localdata localdata_mv
             );
 
 
@@ -36,6 +38,11 @@ require Exporter;
                   ']' => ']'
 );
 
+$pi = 3.141592653589;
+$d2r = ($pi/180);
+$r2d = (180/$pi);
+
+
 # a full time for logging and other purposes
 sub atime
 {
@@ -374,18 +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,3}                                 # 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;
+
+       # 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
 }
        
 
@@ -418,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
@@ -427,6 +437,12 @@ sub is_latlong
        return $_[0] =~ /^\s*\d{1,2}\s+\d{1,2}\s*[NnSs]\s+1?\d{1,2}\s+\d{1,2}\s*[EeWw]\s*$/;
 }
 
+# is it an ip address?
+sub is_ipaddr
+{
+    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
 sub insertitem
 {
@@ -449,3 +465,35 @@ sub deleteitem
        return $n - @$list;
 }
 
+# find the correct local_data directory
+# basically, if there is a local_data directory with this filename and it is younger than the
+# equivalent one in the (system) data directory then return that name rather than the system one
+sub localdata
+{
+       my $ifn = shift;
+       my $ofn = "$main::data/$ifn";
+       my $tfn;
+       
+       if (-e "$main::local_data") {
+               $tfn = "$main::local_data/$ifn";
+               if (-e $tfn && -e $ofn) {
+                       $ofn = $tfn if -M $tfn < -M $ofn;
+               } elsif (-e $tfn) {
+                       $ofn = $tfn;
+               }
+       }
+
+       return $ofn;
+}
+
+# move a file or a directory from data -> local_data if isn't there already
+sub localdata_mv
+{
+       my $ifn = shift;
+       if (-e "$main::data/$ifn" ) {
+               unless (-e "$main::local_data/$ifn") {
+                       move("$main::data/$ifn", "$main::local_data/$ifn") or die "localdata_mv: cannot move $ifn from '$main::data' -> '$main::local_data' $!\n";
+               }
+       }
+}
+