use IO::File;
use File::Copy;
use Data::Dumper;
-
+use Time::HiRes qw(gettimeofday tv_interval);
use strict;
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
);
sub is_callsign
{
return $_[0] =~ m!^
- (?:(?:[A-Z]{1,2}\d* | \d[A-Z]{1,2}\d*)/)? # out of area prefix /
- (?:[A-Z]{1,2}\d+ | \d[A-Z]{1,2}\d+)? # main prefix one
- [A-Z]{1,5} # callsign letters
- (?:-\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
+ (?:\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)
+ (?:/[0-9A-Z]{1,7})? # / another prefix, callsign or special label (including /MM, /P as well as /EURO or /LGT) possibly
$!x;
# longest callign allowed is 1X11/1Y11XXXXX-11/XXXXXXX
# does it look like a qra locator?
sub is_qra
{
- return $_[0] =~ /^[A-Ra-r][A-Ra-r]\d\d[A-Xa-x][A-Xa-x]$/;
+ return unless length $_[0] == 4 || length $_[0] == 6;
+ return $_[0] =~ /^[A-Ra-r][A-Ra-r]\d\d(?:[A-Xa-x][A-Xa-x])?$/;
}
# does it look like a valid lat/long
# is it an ip address?
sub is_ipaddr
{
- return $_[0] =~ /^\d+\.\d+\.\d+\.\d+$/ || $_[0] =~ /^[0-9a-f:]+$/;
+ 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
}
}
+# measure the time taken for something to happen; use Time::HiRes qw(gettimeofday tv_interval);
+sub diffms
+{
+ my $call = shift;
+ my $line = shift;
+ my $ta = shift;
+ my $no = shift;
+ my $tb = shift || [gettimeofday];
+
+ my $a = int($ta->[0] * 1000) + int($ta->[1] / 1000);
+ my $b = int($tb->[0] * 1000) + int($tb->[1] / 1000);
+ my $msecs = $b - $a;
+
+ $line =~ s|\s+$||;
+ my $s = "subprocess stats cmd: '$line' $call ${msecs}mS";
+ $s .= " $no lines" if $no;
+ DXDebug::dbg($s);
+}