New improved route finding algorithm

[spider.git] / perl / RouteDB.pm

diff --git a/perl/RouteDB.pm b/perl/RouteDB.pm
deleted file mode 100644 (file)
index 8059b08..0000000
--- a/perl/RouteDB.pm
+++ /dev/null
@@ -1,145 +0,0 @@
-# This module is used to keep a list of where things come from
-#
-# all interfaces add/update entries in here to allow casual
-# routing to occur.
-# 
-# It is up to the protocol handlers in here to make sure that 
-# this information makes sense. 
-#
-# This is (for now) just an adjunct to the normal routing
-# and is experimental. It will override filtering for
-# things that are explicitly routed (pings, talks and
-# such like).
-#
-# Copyright (c) 2004 Dirk Koopman G1TLH
-#
-#
-# 
-
-package RouteDB;
-
-use DXDebug;
-use DXChannel;
-use DXUtil;
-use Prefix;
-
-use strict;
-
-use vars qw(%list %valid $default);
-
-
-%list = ();
-$default = 99;                                 # the number of hops to use if we don't know
-%valid = (
-                 call => "0,Callsign",
-                 item => "0,Interfaces,parray",
-                 t => '0,Last Seen,atime',
-                 hops => '0,Hops',
-                 count => '0,Times Seen',
-                );
-
-sub new
-{
-       my $pkg = shift;
-       my $call = shift;
-       return bless {call => $call, list => {}}, (ref $pkg || $pkg);
-}
-
-# get the best one
-sub get
-{
-       my @out = _sorted(shift);
-       return @out ? $out[0]->{call} : undef;
-}
-
-# get all of them in sorted order
-sub get_all
-{
-       my @out = _sorted(shift);
-       return @out ? map { $_->{call} } @out : ();
-}
-
-# get them all, sorted into reverse occurance order (latest first)
-# with the smallest hops
-sub _sorted
-{
-       my $call = shift;
-       my $ref = $list{$call};
-       return () unless $ref;
-       return sort {
-               if ($a->{hops} == $b->{hops}) {
-                       $b->{t} <=> $a->{t};
-               } else {
-                       $a->{hops} <=> $b->{hops};
-               } 
-       } values %{$ref->{item}};
-}
-
-
-# add or update this call on this interface
-#
-# RouteDB::update($call, $interface, $hops, time);
-#
-sub update
-{
-       my $call = shift;
-       my $interface = shift;
-       my $hops = shift || $default;
-       my $ref = $list{$call} || RouteDB->new($call);
-       my $iref = $ref->{item}->{$interface} ||= RouteDB::Item->new($interface, $hops);
-       $iref->{count}++;
-       $iref->{hops} = $hops if $hops < $iref->{hops};
-       $iref->{t} = shift || $main::systime;
-       $ref->{item}->{$interface} ||= $iref;
-       $list{$call} ||= $ref;
-}
-
-sub delete
-{
-       my $call = shift;
-       my $interface = shift;
-       my $ref = $list{$call};
-       delete $ref->{item}->{$interface} if $ref;
-}
-
-sub delete_interface
-{
-       my $interface = shift;
-       foreach my $ref (values %list) {
-               delete $ref->{item}->{$interface};
-       }
-}
-
-#
-# generic AUTOLOAD for accessors
-#
-sub AUTOLOAD
-{
-       no strict;
-       my $name = $AUTOLOAD;
-       return if $name =~ /::DESTROY$/;
-       $name =~ s/^.*:://o;
-  
-       confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
-
-       # this clever line of code creates a subroutine which takes over from autoload
-       # from OO Perl - Conway
-       *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
-       goto &$AUTOLOAD;
-
-}
-
-package RouteDB::Item;
-
-use vars qw(@ISA);
-@ISA = qw(RouteDB);
-
-sub new
-{
-       my $pkg = shift;
-       my $call = shift;
-       my $hops = shift || $RouteDB::default;
-       return bless {call => $call, hops => $hops}, (ref $pkg || $pkg);
-}
-
-1;