X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUtil.pm;h=e3056e95e05a59cc78c81adaa058428bc34d497b;hb=b9dffeff7239952814342dad19db3a51def6fab7;hp=705e5cc6c6eb02bdae3acf8eb003889182645205;hpb=e07645cec07ba739a20cc009d7dd138c962b66eb;p=spider.git diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 705e5cc6..e3056e95 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -15,21 +15,16 @@ 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,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; - use vars qw(@month %patmap @ISA @EXPORT); 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 + is_prefix dd ); @@ -133,6 +128,22 @@ sub yesno return $n ? $main::yes : $main::no; } +# provide a data dumpered version of the object passed +sub dd +{ + my $value = shift; + my $dd = new Data::Dumper([$value]); + $dd->Indent(0); + $dd->Terse(1); + $dd->Quotekeys($] < 5.005 ? 1 : 0); + $value = $dd->Dumpxs; + $value =~ s/([\r\n\t])/sprintf("%%%02X", ord($1))/eg; + $value =~ s/^\s*\[//; + $value =~ s/\]\s*$//; + + return $value; +} + # format a prompt with its current value and return it with its privilege sub promptf { @@ -144,12 +155,7 @@ sub promptf my $q = qq{\$value = $action(\$value)}; eval $q; } elsif (ref $value) { - my $dd = new Data::Dumper([$value]); - $dd->Indent(0); - $dd->Terse(1); - $dd->Quotekeys(0); - $value = $dd->Dumpxs; - $value =~ s/([\r\n\t])/sprintf("%%%02X", ord($1))/eg; + $value = dd($value); } $prompt = sprintf "%15s: %s", $prompt, $value; return ($priv, $prompt); @@ -162,6 +168,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 { @@ -350,6 +369,12 @@ sub is_callsign $!x; } +sub is_prefix +{ + return $_[0] =~ m!^(?:[A-Z]{1,2}\d+ | \d[A-Z]{1,2}\d+)!x # basic prefix +} + + # check that a PC protocol field is valid text sub is_pctext {