badcount => '1,Bad Word Count',
edit => '7,Edit Function',
registered => '9,Registered?,yesno',
+ prompt => '0,Required Prompt',
+ version => '1,Node Version',
+ build => '1,Node Build',
+ verified => '9,Verified?,yesno',
+ newroute => '1,New Style Routing,yesno',
+ ve7cc => '0,VE7CC program special,yesno',
+ lastmsgpoll => '0,Last Msg Poll,atime',
+ inscript => '9,In a script,yesno',
+ inqueue => '9,Input Queue,parray',
);
use vars qw($VERSION $BRANCH);
$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
-$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
+$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0));
$main::build += $VERSION;
$main::branch += $BRANCH;
$self->{itu} = $dxcc[1]->itu;
$self->{cq} = $dxcc[1]->cq;
}
+ $self->{inqueue} = [];
$count++;
dbg("DXChannel $self->{call} created ($count)") if isdbg('chan');
return $channels{$call} = $self;
}
-# obtain a channel object by callsign [$obj = DXChannel->get($call)]
+sub rec
+{
+ my ($self, $msg) = @_;
+
+ # queue the message and the channel object for later processing
+ if (defined $msg) {
+ push @{$self->{inqueue}}, $msg;
+ }
+}
+
+# obtain a channel object by callsign [$obj = DXChannel::get($call)]
sub get
{
- my ($pkg, $call) = @_;
+ my $call = shift;
return $channels{$call};
}
# obtain all the channel objects
sub get_all
{
- my ($pkg) = @_;
return values(%channels);
}
sub is_node
{
my $self = shift;
- return $self->{'sort'} =~ /[ACRSX]/;
+ return $self->{'sort'} =~ /[ACRSXW]/;
}
# is it an ak1a node ?
sub is_ak1a
return $self->{'sort'} eq 'C';
}
+# it is Aranea
+sub is_aranea
+{
+ my $self = shift;
+ return $self->{'sort'} eq 'W';
+}
+
# is it a spider node
sub is_spider
{
return @_ ? $self->{'sort'} = shift : $self->{'sort'} ;
}
+# find out whether we are prepared to believe this callsign on this interface
+sub is_believed
+{
+ my $self = shift;
+ my $call = shift;
+
+ return grep $call eq $_, $self->user->believe;
+}
+
# handle out going messages, immediately without waiting for the select to drop
# this could, in theory, block
sub send_now
# the above regexp must work
unless (defined $sort && defined $call && defined $line) {
# $data =~ s/([\x00-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg;
- dbg("DUFF Line on $chcall: $data") if isdbg('err');
+ dbg("DUFF Line on $chcall: $data");
return ();
}
if(ref($dxchan) && $call ne $chcall) {
- dbg("DUFF Line come in for $call on wrong channel $chcall") if isdbg('err');
+ dbg("DUFF Line come in for $call on wrong channel $chcall");
return();
}
if ($nref && $dxchan) {
if ($dxchan == $self) {
return 1 unless $user;
+ return 1 if $user eq $node;
my @users = $nref->users;
return 1 if @users == 0 || grep $user eq $_, @users;
- dbg("RSPF: $user not on $node") if isdbg('rspf');
+ dbg("RSPF: $user not on $node") if isdbg('chanerr');
} else {
- dbg("RSPF: Shortest path for $node is " . $nref->dxchan->{call}) if isdbg('rspf');
+ dbg("RSPF: Shortest path for $node is " . $nref->dxchan->{call}) if isdbg('chanerr');
}
} else {
return 1 if $flag;
- dbg("RSPF: required $node not found" ) if isdbg('rspf');
+ dbg("RSPF: required $node not found" ) if isdbg('chanerr');
}
return 0;
}
{
my $s = shift; # the line to be rebroadcast
my @except = @_; # to all channels EXCEPT these (dxchannel refs)
- my @dxchan = DXChannel::get_all_nodes();
+ my @dxchan = get_all_nodes();
my $dxchan;
# send it if it isn't the except list and isn't isolated and still has a hop count
{
my $s = shift; # the line to be rebroadcast
my @except = @_; # to all channels EXCEPT these (dxchannel refs)
- my @dxchan = DXChannel::get_all_nodes();
+ my @dxchan = get_all_nodes();
my $dxchan;
# send it if it isn't the except list and isn't isolated and still has a hop count
my $sort = shift; # the type of transmission
my $fref = shift; # a reference to an object to filter on
my @except = @_; # to all channels EXCEPT these (dxchannel refs)
- my @dxchan = DXChannel::get_all_users();
+ my @dxchan = get_all_users();
my $dxchan;
my @out;
}
}
+sub process
+{
+ foreach my $dxchan (get_all()) {
+
+ while (my $data = shift @{$dxchan->{inqueue}}) {
+ my ($sort, $call, $line) = $dxchan->decode_input($data);
+ next unless defined $sort;
+
+ # do the really sexy console interface bit! (Who is going to do the TK interface then?)
+ dbg("<- $sort $call $line") if $sort ne 'D' && isdbg('chan');
+ if ($dxchan->{disconnecting}) {
+ dbg('In disconnection, ignored');
+ next;
+ }
+
+ # handle A records
+ my $user = $dxchan->user;
+ if ($sort eq 'A' || $sort eq 'O') {
+ $dxchan->start($line, $sort);
+ } elsif ($sort eq 'I') {
+ die "\$user not defined for $call" if !defined $user;
+
+ # normal input
+ $dxchan->normal($line);
+ } elsif ($sort eq 'Z') {
+ $dxchan->disconnect;
+ } elsif ($sort eq 'D') {
+ ; # ignored (an echo)
+ } elsif ($sort eq 'G') {
+ $dxchan->enhanced($line);
+ } else {
+ print STDERR atime, " Unknown command letter ($sort) received from $call\n";
+ }
+ }
+ }
+}
-no strict;
+#no strict;
sub AUTOLOAD
{
- my $self = shift;
+ no strict;
my $name = $AUTOLOAD;
return if $name =~ /::DESTROY$/;
- $name =~ s/.*:://o;
+ $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}} ;
- @_ ? $self->{$name} = shift : $self->{$name} ;
+ *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
+ goto &$AUTOLOAD;
}