X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUtil.pm;h=7fae63170d015345b5372ab41c234d7d14a538fc;hb=adf3cc7462a4544d2bca7f380593631edcff120b;hp=f5263a271f55d20d9fd49b811bf389ff0d03ec3b;hpb=fbf952ad4e29eb8132007d0f1f3dc5eb1f4a0ff4;p=spider.git diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index f5263a27..7fae6317 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -9,15 +9,24 @@ package DXUtil; use Date::Parse; +use IO::File; + use Carp; require Exporter; @ISA = qw(Exporter); -@EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf parray parraypairs - print_all_fields cltounix +@EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf + parray parraypairs shellregex readfilestr + print_all_fields cltounix iscallsign ); @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); +%patmap = ( + '*' => '.*', + '?' => '.', + '[' => '[', + ']' => ']' +); # a full time for logging and other purposes sub atime @@ -64,12 +73,17 @@ sub cltounix { my $date = shift; my $time = shift; + my ($thisyear) = (gmtime)[5] + 1900; - return 0 unless /^\s*(\d+)-(\w\w\w)-([12][90]\d\d)$/; + return 0 unless $date =~ /^\s*(\d+)-(\w\w\w)-([12][90]\d\d)$/; + return 0 if $3 > 2036; + return 0 unless abs($thisyear-$3) <= 1; $date = "$1 $2 $3"; - return 0 unless /^(\d\d)(\d\d)Z$/; + return 0 unless $time =~ /^([012]\d)([012345]\d)Z$/; $time = "$1:$2 +0000"; - return str2time("$date $time"); + my $r = str2time("$date $time"); + return $r unless $r; + return $r == -1 ? undef : $r; } # turn a latitude in degrees into a string @@ -155,7 +169,7 @@ sub print_all_fields my @fields = $ref->fields; my $field; - foreach $field (sort @fields) { + foreach $field (sort {$ref->field_prompt($a) cmp $ref->field_prompt($b)} @fields) { if (defined $ref->{$field}) { my ($priv, $ans) = promptf($ref->field_prompt($field), $ref->{$field}); push @out, $ans if ($self->priv >= $priv); @@ -164,3 +178,54 @@ sub print_all_fields return @out; } +# generate a regex from a shell type expression +# see 'perl cookbook' 6.9 +sub shellregex +{ + my $in = shift; + $in =~ s{(.)} { $patmap{$1} || "\Q$1" }ge; + return '^' . $in . "\$"; +} + +# start an attempt at determining whether this string might be a callsign +sub iscallsign +{ + my $call = shift; + return 1 if $call =~ /^\w+\d+/; + return 1 if $call =~ /^\d+\w+/; + return undef; +} + +# read in a file into a string and return it. +# the filename can be split into a dir and file and the +# file can be in upper or lower case. +# there can also be a suffix +sub readfilestr +{ + my ($dir, $file, $suffix) = @_; + my $fn; + + if ($suffix) { + $fn = "$dir/$file.$suffix"; + unless (-e $fn) { + my $f = uc $file; + $fn = "$dir/$file.$suffix"; + } + } elsif ($file) { + $fn = "$dir/$file"; + unless (-e $fn) { + my $f = uc $file; + $fn = "$dir/$file"; + } + } else { + $fn = $dir; + } + my $fh = new IO::File $fn; + my $s = undef; + if ($fh) { + local $/ = undef; + $s = <$fh>; + $fh->close; + } + return $s; +}