started OOing of PC protocol stuff

diff --git a/Changes b/Changes
index f10d76fe5a40550e7fb7e1acad769a8ab899de15..44880fa912dec17388877450370619da3feede84 100644 (file)
--- 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 c5882c3660ddec7a52cc84338be0a268b8e668df..5ba3b2bd97b0feb7192a2a3847b3e2bf89a693d4 100644 (file)
--- 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 8cc5137f59684c096eb79f4e6c8132becf723023..822beea5fe7bb3ce5ba0c0beaf81f5c206705f40 100644 (file)
--- 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 9264d50501b05440e35c481e69f0e6d3c60807ef..d1079035b1ada28fa5b1133ef3c8bd06a3d3ea5c 100644 (file)
--- 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 (file)
index 0000000..7ec71e5
--- /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 (file)
index 0000000..4576196
--- /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__