X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUtil.pm;h=49cba9e972ad55fab0d4300c5d4eb72103254382;hb=cd5b993f99b52d3c3c51779e9ea1fa150232225e;hp=2b308407bfe591a9fee4badf0fdc5d39db9eeb78;hpb=e625fa02c8ba985d4d929db0792e935c90c19dcf;p=spider.git diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 2b308407..49cba9e9 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -3,7 +3,7 @@ # # Copyright (c) 1998 - Dirk Koopman G1TLH # -# $Id$ +# # package DXUtil; @@ -15,17 +15,16 @@ use Data::Dumper; use strict; -use vars qw($VERSION $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 + 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 dxver + is_prefix dd is_ipaddr ); @@ -195,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]; @@ -206,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; @@ -370,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 @@ -414,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 { @@ -436,20 +467,3 @@ sub deleteitem return $n - @$list; } -sub dxver -{ - my $s = shift; - my ($a, $b, $c, $d) = $s =~ /(\d+)\.(\d+)\.(?:(\d+)\.(\d+))?/; - - my $v = sprintf( "%d.%03d", $a, $b) || 0; - my $br = sprintf( "%d.%03d", $c, $d) if defined $c; - $br ||= 0; - - $main::build += $v; - $main::branch += $br; - return ($v, $br); -} - -INIT { - ($VERSION, $BRANCH) = dxver(q$Revision$); -}