X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUtil.pm;h=182cde345ca8b0417b52e14619f41b460c657d4f;hb=6eacc3d2fb49a6babfd77d8a0186c30968cb86ca;hp=baa041d42bce04d1c232d2e4edf7cfb79ec2e8d0;hpb=f18ba64dd93bbf7c47e6b5143bfc99af817888e8;p=spider.git diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index baa041d4..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 ahour piplist mindate adate + diffms _diffms _diffus difft parraydifft is_ztime basecall ); @@ -54,24 +54,6 @@ sub atime return $buf; } -# just the hour -sub ahour -{ - my $t = shift; - my ($sec,$min,$hour,$mday,$mon,$year) = gmtime((defined $t) ? $t : time); - my $buf = sprintf "%02d:%02d:%02d", $hour, $min, $sec; - return $buf; -} - -sub adate -{ - my $t = shift; - my ($sec,$min,$hour,$mday,$mon,$year) = gmtime((defined $t) ? $t : time); - $year += 1900; - my $buf = sprintf "%02d%s%04d", $mday, $month[$mon], $year; - return $buf; -} - # get a zulu time in cluster format (2300Z) sub ztime { @@ -200,7 +182,7 @@ sub ptimelist my $ref = shift; my $out; for (sort keys %$ref) { - $out .= "$_=$ref->{$_}, "; + $out .= "$_=" . atime($ref->{$_}) . ", "; } chop $out; chop $out; @@ -211,7 +193,7 @@ sub ptimelist sub parray { my $ref = shift; - return ref $ref ? join(',', @{$ref}) : $ref; + return ref $ref ? join(', ', @{$ref}) : $ref; } # take the arg as an array reference and print as a list of pairs @@ -238,58 +220,13 @@ sub phash my $out; while (my ($k,$v) = each %$ref) { - if (ref $v eq 'ARRAY') { - $out = "${k}=>[" . parray($v) . "],"; - } elsif (ref $v eq 'HASH') { - $out = "${k}=>{" . phash($v) . "},"; - } else { - $out .= "${k}=>$v,"; - } + $out .= "${k}=>$v, "; } + chop $out; # remove last space chop $out; # remove last comma return $out; } -sub mindate -{ - my $t = shift; - my $out; - - if ($main::system-$t < 86400 ) { - $out = ahour($t); - } elsif ($main::system-$t < 365*86400) { - $out = adate($t); - chop $out for (1..4); - $out .= ' ' . atime($t); - chop $out for (1..3); - } else { - $out = atime($t); - $out =~ s/\@/ /; - } - return $out; -} - -# like phash but prints dates and times -sub piplist -{ - my $ref = shift; - my $out; - - return $ref unless ref $ref; - - while (my ($k,$v) = each %$ref) { - if (ref $v eq 'HASH') { - $out .= piplist($v); - } elsif (ref $v eq 'ARRAY') { - $out .= join(',', map { sprintf "$_->[0]@%s", mindate($_->[1]) } ref $v->[0] eq 'ARRAY' ? @$v : $v); - } else { - $out .= $v; - } - } - $out =~ s/,+$//; # remove last comma - return $out; -} - sub _sort_fields { my $ref = shift; @@ -446,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; @@ -507,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 { @@ -535,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 @@ -571,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; @@ -585,3 +539,59 @@ sub diffms $s .= " $no lines" if $no; DXDebug::dbg($s); } + +# expects either an array reference or two times (in the correct order [start, end]) +sub difft +{ + my $b = shift; + my $adds = shift; + + my $t; + if (ref $b eq 'ARRAY') { + $t = $b->[1] - $b->[0]; + } else { + 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 .= sprintf ("%s${d}d", $adds?' ':'') if $d; + $t -= $d * 86400; + $h = int $t / 3600; + $out .= sprintf ("%s${h}h", $adds?' ':'') if $h; + $t -= $h * 3600; + $m = int $t / 60; + $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; +} + +# print an array ref of difft refs +sub parraydifft +{ + my $r = shift; + my $out = ''; + for (@$r) { + my $s = $_->[2] ? "($_->[2])" : ''; + $out .= sprintf "%s=%s$s, ", atime($_->[0]), difft($_->[0], $_->[1]); + } + $out =~ s/,\s*$//; + return $out; +} + +sub basecall +{ + $_[0] =~ m|^(?:[\w\d]+/)?([\w\d]+).*$|; + return $1; +}