3 # This module impliments the abstracted routing for all protocols and
4 # is probably what I SHOULD have done the first time.
8 # This is just a container class which I expect to subclass
10 # Copyright (c) 2001 Dirk Koopman G1TLH
21 use vars qw(%list %valid);
29 my ($pkg, $call) = @_;
30 dbg('route', "$pkg created $call");
31 return bless {call => $call}, $pkg;
35 # get a callsign from a passed reference or a string
42 $thingy = $self unless $thingy;
43 $thingy = $thingy->call if ref $thingy;
44 $thingy = uc $thingy if $thingy;
49 # add and delete a callsign to/from a list
57 my $call = _getcall($c);
58 unless (grep {$_ eq $call} @{$self->{$field}}) {
59 push @{$self->{$field}}, $call;
60 dbg('route', ref($self) . " adding $call to " . $self->{call} . "->\{$field\}");
70 my $call = _getcall($c);
71 if (grep {$_ eq $call} @{$self->{$field}}) {
72 $self->{$field} = [ grep {$_ ne $call} @{$self->{$field}} ];
73 dbg('route', ref($self) . " deleting $call from " . $self->{call} . "->\{$field\}");
87 dbg('route', "$pkg $self->{call} destroyed");
92 # return a list of valid elements
98 my @out, keys %pkg::valid if ref $pkg;
99 push @out, keys %valid;
104 # return a prompt for a field
109 my ($self, $ele) = @_;
111 return $pkg::valid{$ele} || $valid{$ele};
115 # generic AUTOLOAD for accessors
120 my ($pkg, $name) = $AUTOLOAD =~ /^(.*)::([^:]*)$/;
121 return if $name eq 'DESTROY';
123 confess "Non-existant field '$AUTOLOAD'" unless $valid{$name} || $pkg::valid{$name};
125 # this clever line of code creates a subroutine which takes over from autoload
126 # from OO Perl - Conway
127 *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
128 @_ ? $self->{$name} = shift : $self->{$name} ;