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 use DXUtil;
  10 use DXDebug;
  11 use vars qw(%valid);
  12
  13 %valid = (
  14                   fromnode => '0,From Node',
  15                   tonode => '0,To Node',
  16                   vianode => '0,Via Node',
  17                   origin => '0,Original Node',
  18                   tocall => '0,To Callsign',
  19                   fromcall => '0,From Callsign',
  20                   hops => '0,No. of hops',
  21                   text => '0,Text',
  22                   datetime => '0,Date/Time,atime',
  23                   freq => '0,Frequency',
  24                   dxcall => '0,DX Callsign',
  25                   sort => '0,Sort',
  26                   hereflag => '0,Here?,yesno',
  27                   talkflag => '0,Talk mode',
  28                   bellflag => '0,Bell?',
  29                   privflag => '0,Private?,yesno',
  30                   rrflag => '0,RR Req.?,yesno',
  31                   sysopflag => '0,Sysop flag',
  32                   dxcount => '0,DX Count',
  33                   wwvcount => '0,WWV Count',
  34                   version => '0,Node Version',
  35                   nodelist => '0,Node List,parray',
  36                  );
  37
  38
  39 sub new
  40 {
  41         my $pkg = shift;
  42         my $sort = shift;
  43         my $self = bless { sort => $sort }, $pkg;
  44         return $self;
  45 }
  46
  47 sub AUTOLOAD
  48 {
  49         no strict "refs";
  50         my $self = shift;
  51         my $name = $AUTOLOAD;
  52         return if $name =~ /::DESTROY$/;
  53         $name =~ s/.*:://o;
  54
  55         confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
  56         *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
  57     @_ ? $self->{$name} = shift : $self->{$name} ;
  58 }
  59
  60 1;
  61 __END__