From: minima Date: Fri, 18 Aug 2000 18:53:41 +0000 (+0000) Subject: started OOing of PC protocol stuff X-Git-Tag: R_1_44~31 X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=1910df7183401a62084e85c3ace179df492a6fbe;p=spider.git started OOing of PC protocol stuff --- diff --git a/Changes b/Changes index f10d76fe..44880fa9 100644 --- a/Changes +++ b/Changes @@ -2,6 +2,7 @@ 1. added a couple of changes for perl 5.6.0 2. removed del_dup from DXUser for earlier versions of DB '1.85' (ie real ones not 2.x versions in 1.85 compatibility mode). +3. Started the OOing of the PC protocol stuff. 15Aug00======================================================================= 1. added 1.25 of the admin manual html 14Aug00======================================================================= diff --git a/perl/DXProt.pm b/perl/DXProt.pm index c5882c36..5ba3b2bd 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -1426,11 +1426,6 @@ sub disconnect $self->SUPER::disconnect; } -# check that a field only has callsign characters in it -sub is_callsign -{ - return $_[0] !~ /[^A-Z0-9\-]/ -} # # send a talk message to this thingy diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index 8cc5137f..822beea5 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -338,6 +338,7 @@ sub pc85 my($fromnode, $tonode, $call, $msg) = @_; return "PC85^$tonode^$fromnode^$call^$msg^~"; } + 1; __END__ diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 9264d505..d1079035 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 + print_all_fields cltounix iscallsign unpad is_callsign ); @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); @@ -289,7 +289,20 @@ sub unpad return $s; } +# check that a field only has callsign characters in it +sub is_callsign +{ + return $_[0] !~ /[^A-Z0-9\-]/; +} +# check that a PC protocol field is valid text +sub is_pctext +{ + return $_[0] !~ /[^\x20-\xA8\xE0-\xEF]/; +} - - +# check that a PC prot flag is set correctly +sub is_pcflag +{ + return $_[0] !~ /^[^01\*]$/; +} diff --git a/perl/PC.pm b/perl/PC.pm new file mode 100644 index 00000000..7ec71e54 --- /dev/null +++ b/perl/PC.pm @@ -0,0 +1,47 @@ +# +# OO version of all the PC protocol stuff +# +# Here is done all reception, validation and generation of PC +# protocol frames +# +# This uses the Prot class as a basis for all +# protocol entities +# + +package PC10; + +@ISA = qw(Prot); +use DXUtil; + +use strict; + +sub new +{ + my $pkg = shift; + my $self = SUPER->new($pkg); + $self->{from} = shift; + $self->{to} = shift; # is TO if {to} is blank + $self->{text} = shift; + $self->{flag} = shift; + my $auxto = shift; + $self->{origin} = shift; + + # sort out the to/via dillema and do some validation + if (is_callsign($auxto)) { + $self->{via} = $self->{to}; + $self->{to} = $auxto; + return undef unless is_callsign($self->{via}); + } + return undef unless is_callsign($self->{from}) && is_callsign($self->{to}) && is_callsign($self->{origin}) && is_pctext($self->{text}) && is_pcflag($self->{flag}); + return $self; +} + +sub out { + my $self = shift; + my $addra = $self->{via} || $self->{to}; + my $addrb = exists $self->{via} ? $self->{to} : ' '; + return "PC10^$self->{from}^$addra^$self->{text}^$self->{flag}^$addrb^$self->{origin}^~"; +} + +1; +__END__ diff --git a/perl/Prot.pm b/perl/Prot.pm new file mode 100644 index 00000000..4576196a --- /dev/null +++ b/perl/Prot.pm @@ -0,0 +1,18 @@ +# +# Base class for OO version of all protocol stuff +# + +package Prot; + +use strict; + +sub new +{ + my $pkg = shift; + my $self = bless {}, $pkg; + return $self; +} + + +1; +__END__