X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUtil.pm;h=018a404a6249baa43fe2987ff24520c25cf33d59;hb=980b697bd47c8f575b1c9a7f01f9b01adc6746bd;hp=9a911b70e4f6dccc2c7968bc9e4523d0ce4734f1;hpb=2b58ccdf81685a1167a43c38705a0d84b9d8d661;p=spider.git diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 9a911b70..018a404a 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -183,6 +183,14 @@ sub parraypairs return $out; } +sub _sort_fields +{ + my $ref = shift; + my @a = split /,/, $ref->field_prompt(shift); + my @b = split /,/, $ref->field_prompt(shift); + return lc $a[1] cmp lc $b[1]; +} + # print all the fields for a record according to privilege # # The prompt record is of the format ',[,' @@ -195,15 +203,17 @@ sub print_all_fields my @out; my @fields = $ref->fields; my $field; + my $width = $self->width - 1; + $width ||= 80; - foreach $field (sort {$ref->field_prompt($a) cmp $ref->field_prompt($b)} @fields) { + foreach $field (sort {_sort_fields($ref, $a, $b)} @fields) { if (defined $ref->{$field}) { my ($priv, $ans) = promptf($ref->field_prompt($field), $ref->{$field}); my @tmp; - if (length $ans > 79) { + if (length $ans > $width) { my ($p, $a) = split /: /, $ans, 2; my $l = (length $p) + 2; - my $al = 79 - $l; + my $al = ($width - 1) - $l; my $bit; while (length $a > $al ) { ($bit, $a) = unpack "A$al A*", $a; @@ -323,7 +333,7 @@ sub unpad # check that a field only has callsign characters in it sub is_callsign { - return $_[0] =~ /^(?:[A-Z]{1,2}\d+|\d[A-Z]\d+)[A-Z]+(?:-\d{1,2}|\/[A-Z0-9]+)?$/; + return $_[0] =~ /^(?:[A-Z]{1,2}\d+|\d[A-Z]\d+)[A-Z]{1,3}(?:-\d{1,2}|\/(?:[A-Z]{1,2}\d{0,2}|\d[A-Z]\d{0,2}))?$/; } # check that a PC protocol field is valid text @@ -341,7 +351,7 @@ sub is_pcflag # check that a thing is a frequency sub is_freq { - return $_[0] =~ /^[\d\.]+$/; + return $_[0] =~ /^\d+(?:\.\d+)?$/; } # check that a thing is just digits