add more code gradually
[spider.git] / 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::Hi;
26 use Thingy::Route;
27
28 use vars qw(@queue);
29 @queue = ();                                    # the thingy queue
30
31 # we expect all thingies to be subclassed
32 sub new
33 {
34         my $class = shift;
35         my $self = {@_};
36         
37         my ($type) = $class =~ /::(\w+)$/;
38         
39         bless $self, $class;
40         $self->{_tonode} ||= '*';
41         $self->{_fromnode} ||= $main::mycall;
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 queue
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 = lc $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