perl/Prot.pm

   1 #
   2 # Base class for OO version of all protocol stuff
   3 #
   4
   5 package Prot;
   6
   7 use strict;
   8
   9
  10 use vars qw($VERSION $BRANCH);
  11 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
  12 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
  13 $main::build += $VERSION;
  14 $main::branch += $BRANCH;
  15
  16 use DXUtil;
  17 use DXDebug;
  18 use vars qw(%valid);
  19
  20 %valid = (
  21                   fromnode => '0,From Node',
  22                   tonode => '0,To Node',
  23                   vianode => '0,Via Node',
  24                   origin => '0,Original Node',
  25                   tocall => '0,To Callsign',
  26                   fromcall => '0,From Callsign',
  27                   hops => '0,No. of hops',
  28                   text => '0,Text',
  29                   datetime => '0,Date/Time,atime',
  30                   freq => '0,Frequency',
  31                   dxcall => '0,DX Callsign',
  32                   sort => '0,Sort',
  33                   hereflag => '0,Here?,yesno',
  34                   talkflag => '0,Talk mode',
  35                   bellflag => '0,Bell?',
  36                   privflag => '0,Private?,yesno',
  37                   rrflag => '0,RR Req.?,yesno',
  38                   sysopflag => '0,Sysop flag',
  39                   dxcount => '0,DX Count',
  40                   wwvcount => '0,WWV Count',
  41                   version => '0,Node Version',
  42                   nodelist => '0,Node List,parray',
  43                  );
  44
  45
  46 sub new
  47 {
  48         my $pkg = shift;
  49         my $sort = shift;
  50         my $self = bless { sort => $sort }, $pkg;
  51         return $self;
  52 }
  53
  54 sub AUTOLOAD
  55 {
  56 #       no strict "refs";
  57         my $self = shift;
  58         no strict;
  59         my $name = $AUTOLOAD;
  60         return if $name =~ /::DESTROY$/;
  61         $name =~ s/^.*:://o;
  62
  63         confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
  64         *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
  65         &$AUTOLOAD($self, @_);
  66 #       *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
  67 #    @_ ? $self->{$name} = shift : $self->{$name} ;
  68 }
  69
  70 1;
  71 __END__