X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUtil.pm;h=49cba9e972ad55fab0d4300c5d4eb72103254382;hb=cd5b993f99b52d3c3c51779e9ea1fa150232225e;hp=2e7536accabbbfd749f68f20ac20b907df231d3f;hpb=776d7bb9277c9d24708e297f240395b51b0aaa93;p=spider.git diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 2e7536ac..49cba9e9 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -3,7 +3,7 @@ # # Copyright (c) 1998 - Dirk Koopman G1TLH # -# $Id$ +# # package DXUtil; @@ -20,11 +20,11 @@ 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 + parray parraypairs phex phash shellregex readfilestr writefilestr filecopy ptimelist - print_all_fields cltounix unpad is_callsign is_latlong + print_all_fields cltounix unpad is_callsign is_long_callsign is_latlong is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem - is_prefix dd + is_prefix dd is_ipaddr ); @@ -194,7 +194,7 @@ sub parraypairs my $ref = shift; my $i; my $out; - + for ($i = 0; $i < @$ref; $i += 2) { my $r1 = @$ref[$i]; my $r2 = @$ref[$i+1]; @@ -205,6 +205,20 @@ sub parraypairs return $out; } +# take the arg as a hash reference and print it out as such +sub phash +{ + my $ref = shift; + my $out; + + while (my ($k,$v) = each %$ref) { + $out .= "${k}=>$v, "; + } + chop $out; # remove last space + chop $out; # remove last comma + return $out; +} + sub _sort_fields { my $ref = shift; @@ -369,6 +383,18 @@ sub is_callsign $!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; +} + sub is_prefix { return $_[0] =~ m!^(?:[A-Z]{1,2}\d+ | \d[A-Z]{1,2}\d+)!x # basic prefix @@ -413,6 +439,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 {