perl/Investigate.pm

   1 #
   2 # Investigate whether an external node is accessible
   3 #
   4 # If it is, make it believable otherwise mark as not
   5 # to be believed.
   6 #
   7 # It is possible to store up state for a node to be
   8 # investigated, so that if it is accessible, its details
   9 # will be passed on to whomsoever might be interested.
  10 #
  11 # Copyright (c) 2004 Dirk Koopman, G1TLH
  12 #
  13 # $Id$
  14 #
  15
  16 use strict;
  17
  18 package Investigate;
  19
  20 use DXDebug;
  21 use DXUtil;
  22
  23
  24 use vars qw($VERSION $BRANCH);
  25 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
  26 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
  27 $main::build += $VERSION;
  28 $main::branch += $BRANCH;
  29
  30 use vars qw (%list %valid);
  31
  32 %list = ();                                             # the list of outstanding investigations
  33 %valid = (                                              # valid fields
  34                   call => '0,Callsign',
  35                   start => '0,Started at,atime',
  36                   version => '0,Node Version',
  37                   build => '0,Node Build',
  38                   here => '0,Here?,yesno',
  39                   conf => '0,In Conf?,yesno',
  40                  );
  41
  42
  43 sub new
  44 {
  45         my $pkg = shift;
  46         my $call = shift;
  47         my $self = $list{$call} || bless { call=>$call, start=>$main::systime }, ref($pkg) || $pkg;
  48         return $self;
  49 }
  50
  51 sub get
  52 {
  53         return $list{$_[0]};
  54 }
  55
  56 sub AUTOLOAD
  57 {
  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
  65         # this clever line of code creates a subroutine which takes over from autoload
  66         # from OO Perl - Conway
  67         *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
  68         goto &$AUTOLOAD;
  69 }
  70 1;