X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUtil.pm;h=705e5cc6c6eb02bdae3acf8eb003889182645205;hb=cbb49d0c832bfe94e35fa79e0fd978e9d3d287db;hp=9d475ed89c8f2f17713b3aabdc9aa6c79d93d4df;hpb=77f4f8ef18caeb6cc96f114cc9a000bc72e19d1b;p=spider.git diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 9d475ed8..705e5cc6 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -10,13 +10,14 @@ package DXUtil; use Date::Parse; use IO::File; +use File::Copy; use Data::Dumper; use strict; use vars qw($VERSION $BRANCH); $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0; +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); $main::build += $VERSION; $main::branch += $BRANCH; @@ -26,6 +27,7 @@ require Exporter; @ISA = qw(Exporter); @EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf parray parraypairs phex shellregex readfilestr writefilestr + filecopy print_all_fields cltounix unpad is_callsign is_latlong is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem ); @@ -147,6 +149,7 @@ sub promptf $dd->Terse(1); $dd->Quotekeys(0); $value = $dd->Dumpxs; + $value =~ s/([\r\n\t])/sprintf("%%%02X", ord($1))/eg; } $prompt = sprintf "%15s: %s", $prompt, $value; return ($priv, $prompt); @@ -163,7 +166,7 @@ sub phex sub parray { my $ref = shift; - return join(', ', @{$ref}); + return ref $ref ? join(', ', @{$ref}) : $ref; } # take the arg as an array reference and print as a list of pairs @@ -321,6 +324,11 @@ sub writefilestr } } +sub filecopy +{ + copy(@_) or return $!; +} + # remove leading and trailing spaces from an input string sub unpad { @@ -333,13 +341,21 @@ sub unpad # check that a field only has callsign characters in it sub is_callsign { - return $_[0] =~ /^(?:[A-Z]{1,2}\d+|\d[A-Z]\d+)[A-Z]+(?:-\d{1,2}|\/[A-Z0-9]+)?$/; + 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; } # check that a PC protocol field is valid text sub is_pctext { - return $_[0] =~ /^[\x09\x20-\xFF]+$/; + return undef unless length $_[0]; + return undef if $_[0] =~ /[\x00-\x08\x0a-\x1f\x80-\x9f]/; + return 1; } # check that a PC prot flag is fairly valid (doesn't check the difference between 1/0 and */-) @@ -363,13 +379,13 @@ sub is_digits # does it look like a qra locator? sub is_qra { - return $_[0] =~ /^[A-Za-z][A-Za-z]\d\d[A-Za-z][A-Za-z]$/o; + return $_[0] =~ /^[A-Ra-r][A-Ra-r]\d\d[A-Xa-x][A-Xa-x]$/; } # does it look like a valid lat/long sub is_latlong { - return $_[0] =~ /^\s*\d{1,2}\s+\d{1,2}\s*[NnSs]\s+\d{1,2}\s+\d{1,2}\s*[EeWw]\s*$/; + return $_[0] =~ /^\s*\d{1,2}\s+\d{1,2}\s*[NnSs]\s+1?\d{1,2}\s+\d{1,2}\s*[EeWw]\s*$/; } # insert an item into a list if it isn't already there returns 1 if there 0 if not