X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUtil.pm;h=0b3de9511e964f41c6834f025bcf4e60b1dc2f2d;hb=888f29019bd55b89ee5c506ee7d2d71f0c3dafb8;hp=07e86cea4a7d5254d8415c49ddecd23f94d3b078;hpb=a91e80b479d48d5d9be339c7aa2ab8cf6621886f;p=spider.git diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 07e86cea..0b3de951 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -16,7 +16,7 @@ require Exporter; @ISA = qw(Exporter); @EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf parray parraypairs shellregex readfilestr writefilestr - print_all_fields cltounix iscallsign unpad is_callsign + print_all_fields cltounix unpad is_callsign is_freq is_digits is_pctext is_pcflag insertitem deleteitem ); @@ -183,12 +183,13 @@ sub print_all_fields my ($priv, $ans) = promptf($ref->field_prompt($field), $ref->{$field}); my @tmp; if (length $ans > 79) { - my ($p, $a) = split /: /, $ans; + my ($p, $a) = split /: /, $ans, 2; my $l = (length $p) + 2; my $al = 79 - $l; + my $bit; while (length $a > $al ) { - $a =~ s/^(.{$al})//; - push @tmp, "$p: $1"; + ($bit, $a) = unpack "A$al A*", $a; + push @tmp, "$p: $bit"; $p = ' ' x ($l - 2); } push @tmp, "$p: $a" if length $a; @@ -210,15 +211,6 @@ sub shellregex return '^' . $in . "\$"; } -# start an attempt at determining whether this string might be a callsign -sub iscallsign -{ - my $call = uc shift; - return 1 if $call =~ /^[A-Z]+\d+[A-Z]+/; - return 1 if $call =~ /^\d+[A-Z]\d+[A-Z]+/; - 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. @@ -313,7 +305,7 @@ sub unpad # check that a field only has callsign characters in it sub is_callsign { - return $_[0] =~ /^[A-Z0-9\-]+$/; + return $_[0] =~ /^(?:[A-Z]{1,2}\d+|\d[A-Z]\d+)[A-Z0-9\/\-]+$/; } # check that a PC protocol field is valid text