1 # This module is used to keep a list of where things come from
3 # all interfaces add/update entries in here to allow casual
6 # It is up to the protocol handlers in here to make sure that
7 # this information makes sense.
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
14 # Copyright (c) 2004 Dirk Koopman G1TLH
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;
33 use vars qw(%list %valid $default);
36 $default = 99; # the number of hops to use if we don't know
39 item => "0,Interfaces,parray",
40 t => '0,Last Seen,atime',
42 count => '0,Times Seen',
49 return bless {call => $call, list => {}}, (ref $pkg || $pkg);
55 my @out = _sorted(shift);
56 return @out ? $out[0]->{call} : undef;
59 # get all of them in sorted order
62 my @out = _sorted(shift);
63 return @out ? map { $_->{call} } @out : ();
66 # get them all, sorted into reverse occurance order (latest first)
67 # with the smallest hops
71 my $ref = $list{$call};
72 return () unless $ref;
74 if ($a->{hops} == $b->{hops}) {
77 $a->{hops} <=> $b->{hops};
79 } values %{$ref->{item}};
83 # add or update this call on this interface
85 # RouteDB::update($call, $interface, $hops, time);
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);
95 $iref->{hops} = $hops if $hops < $iref->{hops};
96 $iref->{t} = shift || $main::systime;
97 $ref->{item}->{$interface} ||= $iref;
98 $list{$call} ||= $ref;
104 my $interface = shift;
105 my $ref = $list{$call};
106 delete $ref->{item}->{$interface} if $ref;
111 my $interface = shift;
112 foreach my $ref (values %list) {
113 delete $ref->{item}->{$interface};
118 # generic AUTOLOAD for accessors
123 my $name = $AUTOLOAD;
124 return if $name =~ /::DESTROY$/;
127 confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
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}};
136 package RouteDB::Item;
145 return bless {call => $call, hops => $RouteDB::default}, (ref $pkg || $pkg);