perl/Thingy.pm

   1 #
   2 # This module is part of the new structure of the cluster
   3 #
   4 # What happens when a sentence comes in is that it is sanity
   5 # checked and then is converted into a Thingy. This Thingy is what
   6 # is the passed around the system.
   7 #
   8 # Copyright (c) 2001 Dirk Koopman G1TLH
   9 #
  10 # $Id$
  11 #
  12
  13 use strict;
  14
  15 package Thingy;
  16
  17 use DXDebug;
  18
  19 use vars qw($VERSION $BRANCH %valid);
  20 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
  21 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
  22 $main::build += $VERSION;
  23 $main::branch += $BRANCH;
  24
  25 %valid = (
  26                   tonode => '0,To Node',
  27                   fromnode => '0,From Node',
  28                   fromchan => '0,DXChannel Ref',
  29                   pcline => '0,Original PC Line',
  30                   qxline => '0,Original QX Line',
  31                   hops => '0,Hops',
  32                  );
  33
  34 sub _valid
  35 {
  36         my @pkg = split /::/, ref shift;
  37         my $field = shift;
  38
  39         # iterate down the packages looking for a 'valid'
  40         no strict 'refs';
  41         while (@pkg >= 1) {
  42                 my $n = join('::'. @pkg, 'valid');
  43                 my $r = $$n{$field};
  44                 return $r if defined $r;
  45                 pop @pkg;
  46         }
  47         return undef;
  48 }
  49
  50 sub new
  51 {
  52         my $pkg = shift;
  53         my $self = bless {}, $pkg;
  54         while (my ($k, $v) = each %{\@_}) {
  55                 confess "Non-existant field '$k'" unless $self->_valid($k);
  56                 $self->{lc $k} = $v;
  57         }
  58         return $self;
  59 }
  60
  61 sub AUTOLOAD
  62 {
  63         my $self = shift;
  64         no strict;
  65         my $name = $AUTOLOAD;
  66         return if $name =~ /::DESTROY$/;
  67         $name =~ s/^.*:://o;
  68
  69         confess "Non-existant field '$AUTOLOAD'" unless $self->_valid($name);
  70
  71         *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
  72         &$AUTOLOAD($self, @_);
  73 }
  74
  75
  76
  77
  78
  79
  80
  81
  82
  83
  84 1;