]> gb7djk.dxcluster.net Git - spider.git/blob - perl/RouteDB.pm
use XML::Parser (it should be adequate for the little things we are doing).
[spider.git] / perl / RouteDB.pm
1 # This module is used to keep a list of where things come from
2 #
3 # all interfaces add/update entries in here to allow casual
4 # routing to occur.
5
6 # It is up to the protocol handlers in here to make sure that 
7 # this information makes sense. 
8 #
9 # This is (for now) just an adjunct to the normal routing
10 # and is experimental. It will override filtering for
11 # things that are explicitly routed (pings, talks and
12 # such like).
13 #
14 # Copyright (c) 2004 Dirk Koopman G1TLH
15 #
16 # $Id$
17
18
19 package RouteDB;
20
21 use DXDebug;
22 use DXChannel;
23 use Prefix;
24
25 use strict;
26
27 use vars qw($VERSION $BRANCH);
28 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
29 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
30 $main::build += $VERSION;
31 $main::branch += $BRANCH;
32
33 use vars qw(%list %valid $default);
34
35 %list = ();
36 $default = 99;                                  # the number of hops to use if we don't know
37 %valid = (
38                   call => "0,Callsign",
39                   item => "0,Interfaces,parray",
40                   t => '0,Last Seen,atime',
41                   hops => '0,Hops',
42                   count => '0,Times Seen',
43                  );
44
45 sub new
46 {
47         my $pkg = shift;
48         my $call = shift;
49         return bless {call => $call, list => {}}, (ref $pkg || $pkg);
50 }
51
52 # get the best one
53 sub get
54 {
55         my @out = _sorted(shift);
56         return @out ? $out[0]->{call} : undef;
57 }
58
59 # get all of them in sorted order
60 sub get_all
61 {
62         my @out = _sorted(shift);
63         return @out ? map { $_->{call} } @out : ();
64 }
65
66 # get them all, sorted into reverse occurance order (latest first)
67 # with the smallest hops
68 sub _sorted
69 {
70         my $call = shift;
71         my $ref = $list{$call};
72         return () unless $ref;
73         return sort {
74                 if ($a->{hops} == $b->{hops}) {
75                         $b->{t} <=> $a->{t};
76                 } else {
77                         $a->{hops} <=> $b->{hops};
78                 } 
79         } values %{$ref->{item}};
80 }
81
82
83 # add or update this call on this interface
84 #
85 # RouteDB::update($call, $interface, $hops, time);
86 #
87 sub update
88 {
89         my $call = shift;
90         my $interface = shift;
91         my $hops = shift || $default;
92         my $ref = $list{$call} || RouteDB->new($call);
93         my $iref = $ref->{item}->{$interface} ||= RouteDB::Item->new($interface);
94         $iref->{count}++;
95         $iref->{hops} = $hops if $hops < $iref->{hops};
96         $iref->{t} = shift || $main::systime;
97         $ref->{item}->{$interface} ||= $iref;
98         $list{$call} ||= $ref;
99 }
100
101 sub delete
102 {
103         my $call = shift;
104         my $interface = shift;
105         my $ref = $list{$call};
106         delete $ref->{item}->{$interface} if $ref;
107 }
108
109 sub delete_interface
110 {
111         my $interface = shift;
112         foreach my $ref (values %list) {
113                 delete $ref->{item}->{$interface};
114         }
115 }
116
117 #
118 # generic AUTOLOAD for accessors
119 #
120 sub AUTOLOAD
121 {
122         no strict;
123         my $name = $AUTOLOAD;
124         return if $name =~ /::DESTROY$/;
125         $name =~ s/^.*:://o;
126   
127         confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
128
129         # this clever line of code creates a subroutine which takes over from autoload
130         # from OO Perl - Conway
131         *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
132        goto &$AUTOLOAD;
133
134 }
135
136 package RouteDB::Item;
137
138 use vars qw(@ISA);
139 @ISA = qw(RouteDB);
140
141 sub new
142 {
143         my $pkg = shift;
144         my $call = shift;
145         return bless {call => $call, hops => $RouteDB::default}, (ref $pkg || $pkg);
146 }
147
148 1;