X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUtil.pm;h=9f411812d6b2207d02d34b2de7581af78fe4314f;hb=7046b8ba37863c3040cee17e46d100675e720eaf;hp=e497a6e9df6c2febbca7c1aa3354ef2e234f7d11;hpb=5c15f6e5521944f56427ef069f449739ce84ce9f;p=spider.git diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index e497a6e9..9f411812 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -27,7 +27,7 @@ require Exporter; @ISA = qw(Exporter); @EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf parray parraypairs phex shellregex readfilestr writefilestr - filecopy + filecopy ptimelist print_all_fields cltounix unpad is_callsign is_latlong is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem ); @@ -149,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); @@ -161,6 +162,19 @@ sub phex return sprintf '%X', $val; } +# take an arg as a hash of call=>time pairs and print it +sub ptimelist +{ + my $ref = shift; + my $out; + for (sort keys %$ref) { + $out .= "$_=$ref->{$_}, "; + } + chop $out; + chop $out; + return $out; +} + # take an arg as an array list and print it sub parray { @@ -340,7 +354,13 @@ 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]{1,2}\d+)[A-Z]{1,3}(?:-\d{1,2}|\/(?:[A-Z]{1,2}\d{0,2}|\d[A-Z]\d{0,2}))?$/; + 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 @@ -378,7 +398,7 @@ sub is_qra # 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