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