X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUtil.pm;h=182cde345ca8b0417b52e14619f41b460c657d4f;hb=4e91a71498653a4033c42440b225245387d7f5da;hp=b7c455198fd35633bb5214d585f85697e5a54823;hpb=102b51ca564ef29e7f84d2cf65d0eaa5fdab671a;p=spider.git diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index b7c45519..182cde34 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -27,7 +27,7 @@ require Exporter; print_all_fields cltounix unpad is_callsign is_latlong is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem is_prefix dd is_ipaddr $pi $d2r $r2d localdata localdata_mv - diffms _diffms difft parraydifft + diffms _diffms _diffus difft parraydifft is_ztime basecall ); @@ -383,10 +383,10 @@ sub unpad sub is_callsign { return $_[0] =~ m!^ - (?:\d?[A-Z]{1,2}\d*/)? # out of area prefix / - (?:\d?[A-Z]{1,2}\d+) # main prefix one (required) - [A-Z]{1,5} # callsign letters (required) - (?:-(?:\d{1,2}|\#))? # - nn possibly (eg G8BPQ-8) or -# (an RBN spot) + (?:\d?[A-Z]{1,2}\d{0,2}/)? # out of area prefix / + (?:\d?[A-Z]{1,2}\d{1,5}) # main prefix one (required) - lengthened for special calls + [A-Z]{1,8} # callsign letters (required) + (?:-(?:\d{1,2}))? # - nn possibly (eg G8BPQ-8) (?:/[0-9A-Z]{1,7})? # / another prefix, callsign or special label (including /MM, /P as well as /EURO or /LGT) possibly $!x; @@ -444,6 +444,12 @@ sub is_ipaddr return $_[0] =~ /^\d+\.\d+\.\d+\.\d+$/ || $_[0] =~ /^[0-9a-f:,]+$/; } +# is it a zulu time hhmmZ +sub is_ztime +{ + return $_[0] =~ /^(?:(?:2[0-3])|(?:[01][0-9]))[0-5][0-9]Z$/; +} + # insert an item into a list if it isn't already there returns 1 if there 0 if not sub insertitem { @@ -472,19 +478,20 @@ sub deleteitem sub localdata { my $ifn = shift; - my $ofn = "$main::local_data/$ifn"; - my $tfn; + my $lfn = "$main::local_data/$ifn"; + my $dfn = "$main::data/$ifn"; if (-e "$main::local_data") { - $tfn = "$main::data/$ifn"; - if ((-e $tfn) && (-e $ofn)) { - $ofn = $tfn if -M $ofn < -M $tfn; + if ((-e $dfn) && (-e $lfn)) { + $lfn = $dfn if -M $dfn < -M $lfn; } else { - $ofn = $tfn if -e $tfn; + $lfn = $dfn if -e $dfn; } + } else { + $lfn = $dfn; } - return $ofn; + return $lfn; } # move a file or a directory from data -> local_data if isn't there already @@ -508,6 +515,16 @@ sub _diffms return $b - $a; } +# and in microseconds +sub _diffus +{ + my $ta = shift; + my $tb = shift || [gettimeofday]; + my $a = int($ta->[0] * 1000000) + int($ta->[1]); + my $b = int($tb->[0] * 1000000) + int($tb->[1]); + return $b - $a; +} + sub diffms { my $call = shift; @@ -527,25 +544,36 @@ sub diffms sub difft { my $b = shift; + my $adds = shift; + my $t; if (ref $b eq 'ARRAY') { $t = $b->[1] - $b->[0]; } else { - $t = shift() - $b; + if ($adds && $adds =~ /^\d+$/ && $adds >= $b) { + $t = $adds - $b; + $adds = shift; + } else { + $t = $main::systime - $b; + } } return '-(ve)' if $t < 0; my ($d,$h,$m,$s); my $out = ''; $d = int $t / 86400; - $out .= "${d}d" if $d; + $out .= sprintf ("%s${d}d", $adds?' ':'') if $d; $t -= $d * 86400; $h = int $t / 3600; - $out .= "${h}h" if $h || $d; + $out .= sprintf ("%s${h}h", $adds?' ':'') if $h; $t -= $h * 3600; $m = int $t / 60; - $out .= "${m}m" if $m || $h || $d; - $s = int $t % 60; - $out .= "${s}s"; + $out .= sprintf ("%s${m}m", $adds?' ':'') if $m; + if ($d == 0 && $adds || $adds == 2) { + $s = int $t % 60; + $out .= sprintf ("%s${s}s", $adds?' ':'') if $s; + $out ||= sprintf ("%s0s", $adds?' ':''); + } + $out = '0s' unless length $out; return $out; } @@ -561,3 +589,9 @@ sub parraydifft $out =~ s/,\s*$//; return $out; } + +sub basecall +{ + $_[0] =~ m|^(?:[\w\d]+/)?([\w\d]+).*$|; + return $1; +}