perl/Thingy.pm

   1 #
   2 # Thingy handling
   3 #
   4 # This is the new fundamental protocol engine handler
   5 #
   6 # $Id$
   7 #
   8 # Copyright (c) 2004 Dirk Koopman G1TLH
   9 #
  10
  11 package Thingy;
  12
  13 use strict;
  14
  15 use vars qw($VERSION $BRANCH);
  16 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
  17 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
  18 $main::build += $VERSION;
  19 $main::branch += $BRANCH;
  20
  21
  22 use DXChannel;
  23 use DXDebug;
  24
  25 use Thingy::Route;
  26
  27 use vars qw(@queue);
  28 @queue = ();                                    # the thingy queue
  29
  30 # we expect all thingies to be subclassed
  31 sub new
  32 {
  33         my $class = shift;
  34         my $self = {@_};
  35
  36         my ($type) = $class =~ /::(\w+)$/;
  37
  38         bless $self, $class;
  39         $self->{_tonode} ||= '*';
  40         $self->{_fromnode} ||= $main::mycall;
  41         $self->{_hoptime} ||= 0;
  42         while (my ($k,$v) = each %$self) {
  43                 delete $self->{$k} unless defined $v;
  44         }
  45         return $self;
  46 }
  47
  48 # add the Thingy to the queue
  49 sub add
  50 {
  51         push @queue, shift;
  52 }
  53
  54 # dispatch Thingies to action it.
  55 sub process
  56 {
  57         my $t = pop @queue if @queue;
  58
  59         if ($t) {
  60
  61                 # go directly to this class's t= handler if there is one
  62                 my $type = $t->{t};
  63                 if ($type) {
  64                         # remove extraneous characters put there by the ungodly
  65                         $type =~ s/[^\w]//g;
  66                         $type = 'handle_' . $type;
  67                         if ($t->can($type)) {
  68                                 no strict 'refs';
  69                                 $t->$type;
  70                                 return;
  71                         }
  72                 }
  73                 $t->normal;
  74         }
  75 }
  76
  77 1;
  78