From 1f2757c4c57b6b4492923ed4edd7f0f912a31157 Mon Sep 17 00:00:00 2001 From: minima Date: Sun, 20 Aug 2000 13:39:46 +0000 Subject: [PATCH] checking now works a bit better --- perl/DXProt.pm | 87 +++++++++++++++++++++++++------------------------ perl/DXUtil.pm | 12 +++---- perl/console.pl | 2 +- 3 files changed, 51 insertions(+), 50 deletions(-) diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 4f9e2220..1d9f1a62 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -51,47 +51,48 @@ $baddxfn = "$main::data/baddx.pl"; @checklist = ( - qw(c c m p bc c), # pc10 - qw(f c m d t c c h), # pc11 - qw(c bc m p c p h), # pc12 - qw(c h), - qw(c h), - qw(c m h), - undef, # pc16 has to be validated manually - qw(c c h), # pc17 - qw(c m n), # pc18 - undef, # pc19 has to be validated manually - undef, # pc20 no validation - qw(c m h), # pc21 - undef, # pc22 no validation - qw(d t n n n m c c h), # pc23 - qw(c p h), # pc24 - qw(c c n n), # pc25 - qw(f c m d t c c), # pc26 - qw(d t n n n m c c), # pc27 - qw(c c c c d t p m bp n p bp c), # pc28 - qw(c c n m), # pc29 - qw(c c n), # pc30 - qw(c c n), # pc31 - qw(c c n), # pc32 - qw(c c n), # pc33 - qw(c c m), # pc34 - qw(c c m), # pc35 - qw(c c m), # pc36 - qw(c c n m), # pc37 - qw(c m), # pc39 - qw(c c m p n), # pc40 - qw(c n m h), # pc41 - qw(c c n), # pc42 + [ qw(c c m p bc c) ], # pc10 + [ qw(f m d t m c c h) ], # pc11 + [ qw(c bc m p c p h) ], # pc12 + [ qw(c h) ], # + [ qw(c h) ], # + [ qw(c m h) ], # + undef , # pc16 has to be validated manually + [ qw(c c h) ], # pc17 + [ qw(m n) ], # pc18 + undef , # pc19 has to be validated manually + undef , # pc20 no validation + [ qw(c m h) ], # pc21 + undef , # pc22 no validation + [ qw(d t n n n m c c h) ], # pc23 + [ qw(c p h) ], # pc24 + [ qw(c c n n) ], # pc25 + [ qw(f c m d t c c) ], # pc26 + [ qw(d t n n n m c c) ], # pc27 + [ qw(c c c c d t p m bp n p bp c) ], # pc28 + [ qw(c c n m) ], # pc29 + [ qw(c c n) ], # pc30 + [ qw(c c n) ], # pc31 + [ qw(c c n) ], # pc32 + [ qw(c c n) ], # pc33 + [ qw(c c m) ], # pc34 + [ qw(c c m) ], # pc35 + [ qw(c c m) ], # pc36 + [ qw(c c n m) ], # pc37 + undef, # pc38 not interested + [ qw(c m) ], # pc39 + [ qw(c c m p n) ], # pc40 + [ qw(c n m h) ], # pc41 + [ qw(c c n) ], # pc42 undef, # pc43 don't handle it - qw(c c n m m c), # pc44 - qw(c c n m), # pc45 - qw(c c n), # pc46 + [ qw(c c n m m c) ], # pc44 + [ qw(c c n m) ], # pc45 + [ qw(c c n) ], # pc46 undef, # pc47 undef, # pc48 - qw(c m h), # pc49 - qw(c n h), # pc50 - qw(c c n), # pc51 + [ qw(c m h) ], # pc49 + [ qw(c n h) ], # pc50 + [ qw(c c n) ], # pc51 undef, undef, undef, @@ -113,7 +114,7 @@ $baddxfn = "$main::data/baddx.pl"; undef, # pc70 undef, undef, - qw(d t n n n n n n m m m c c), # pc73 + [ qw(d n n n n n n n m m m c c) ], # pc73 undef, undef, undef, @@ -124,8 +125,8 @@ $baddxfn = "$main::data/baddx.pl"; undef, undef, undef, - qw(c c c m), # pc84 - qw(c c c m), # pc85 + [ qw(c c c m) ], # pc84 + [ qw(c c c m) ], # pc85 ); # use the entry in the check list to check the field list presented @@ -134,7 +135,7 @@ sub check { my $n = shift; $n -= 10; - return 0 if $n < 10 || $n > @checklist; + return 0 if $n < 0 || $n > @checklist; my $ref = $checklist[$n]; return 0 unless ref $ref; @@ -152,7 +153,7 @@ sub check } elsif ($act eq 'f') { return $i+1 unless is_freq($_[$i]); } elsif ($act eq 'n') { - return $i+1 if $_[$i] !~ /^[^\d ]$/; + return $i+1 unless $_[$i] =~ /^[\d ]+$/; } elsif ($act eq 'h') { return $i+1 unless $_[$i] =~ /^H\d\d?$/; } elsif ($act eq 'd') { diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 0fb6b8db..42ba922b 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -17,7 +17,7 @@ require Exporter; @EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf parray parraypairs shellregex readfilestr writefilestr print_all_fields cltounix iscallsign unpad is_callsign - is_freq is_digits + is_freq is_digits is_pctext is_pcflag ); @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); @@ -293,29 +293,29 @@ sub unpad # check that a field only has callsign characters in it sub is_callsign { - return $_[0] !~ /[^A-Z0-9\-]/; + return $_[0] =~ /^[A-Z0-9\-]+$/; } # check that a PC protocol field is valid text sub is_pctext { - return $_[0] !~ /[^\x20-\xA8\xE0-\xEF]/; + return $_[0] =~ /^[\x09\x20-\xA8\xE0-\xEF]+$/; } # check that a PC prot flag is fairly valid (doesn't check the difference between 1/0 and */-) sub is_pcflag { - return $_[0] !~ /^[^01\*\-]$/; + return $_[0] =~ /^[01\*\-]+$/; } # check that a thing is a frequency sub is_freq { - return $_[0] !~ /[^\d\.]/; + return $_[0] =~ /^[\d\.]+$/; } # check that a thing is just digits sub is_digits { - return $_[0] !~ /[^\d]/; + return $_[0] =~ /^[\d]+$/; } diff --git a/perl/console.pl b/perl/console.pl index 46e42ad1..4d7040cf 100755 --- a/perl/console.pl +++ b/perl/console.pl @@ -368,7 +368,7 @@ sub rec_stdin } else { beep(); } - } elsif ($r ge ' ' && $r le '~') { + } elsif (is_pctext($r)) { # move the top screen back to the bottom if you type something if ($spos < @shistory) { $spos = @shistory; -- 2.43.0