use DXChannel;
use DXDebug;
+use DXUtil;
+
# we expect all thingies to be subclassed
sub new
{
my $class = shift;
+ my $pkg = ref $class || $class;
my $thing = {@_};
$thing->{origin} ||= $main::mycall;
- bless $thing, $class;
+ bless $thing, $pkg;
return $thing;
}
# before send (and line generation) things
# function must return true to make the send happen
$sub = "before_send_$class";
- return unless $thing->can($sub) && $thing->$sub($dxchan);
+ if ($thing->can($sub)) {
+ return unless $thing->$sub($dxchan);
+ }
# generate the protocol line which may (or not) be cached
my $ref;
}
}
-# broadcast to all except @_
+#
+# This is the main routing engine for the new protocol. Broadcast is a slight
+# misnomer, because if it thinks it can route it down one or interfaces, it will.
+#
+# It handles anything it recognises as a callsign, sees if it can find it in a
+# routing table, and if it does, then routes the message.
+#
+# If it can't then it will broadcast it.
+#
sub broadcast
{
my $thing = shift;
dbg("Thingy::broadcast: " . $thing->ascii) if isdbg('thing');
- foreach my $dxchan (DXChannel::get_all()) {
+ my @dxchan;
+ my $to ||= $thing->{route};
+ $to ||= $thing->{touser};
+ $to ||= $thing->{group};
+ if ($to && is_callsign($to) && (my $ref = Route::get($to))) {
+ dbg("Thingy::broadcast: routing for $to") if isdbg('thing');
+ @dxchan = $ref->alldxchan;
+ } else {
+ @dxchan = DXChannel::get_all();
+ }
+
+ dbg("Thingy::broadcast: offered " . join(',', map {$_->call} @dxchan)) if isdbg('thing');
+
+ foreach my $dxchan (@dxchan) {
next if $dxchan == $main::me;
next if grep $dxchan == $_, @_;
+ next if $dxchan->{call} eq $thing->{origin};
+ next if $thing->{user} && !$dxchan->is_user && $dxchan->{call} eq $thing->{user};
+
+ dbg("Thingy::broadcast: sending to $dxchan->{call}") if isdbg('thing');
$thing->send($dxchan);
}
}
sub process
{
my $thing;
+
if (@_ == 2) {
$thing = shift;
$thing->queue(shift);
}
+
while (@queue) {
$thing = shift @queue;
my $dxchan = DXChannel::get($thing->{dxchan});
my $dd = new Data::Dumper([$thing]);
$dd->Indent(0);
$dd->Terse(1);
- $dd->Sortkeys(1);
+ #$dd->Sortkeys(1);
$dd->Quotekeys($] < 5.005 ? 1 : 0);
return $dd->Dumpxs;
}
{
my $thing = shift;
my $s = $thing->{'s'} = sprintf "%X", int(rand() * 100000000);
- my $auth = Verify->new("DXSp,$main::mycall,$s,$main::version,$main::build");
+ my $auth = Verify->new("DXSp,$main::mycall,$s,$thing->{v},$thing->{b}");
$thing->{auth} = $auth->challenge($main::me->user->passphrase);
}
+#
+# create a generalised reply to a passed thing, if it isn't replyable
+# to then undef is returned
+#
+sub new_reply
+{
+ my $thing = shift;
+ my $out;
+
+ if ($thing->{group} eq $main::mycall) {
+ $out = $thing->new;
+ $out->{touser} = $thing->{user} if $thing->{user};
+ $out->{group} = $thing->{origin};
+ } elsif (DXChannel::get($thing->{group})) {
+ $out = $thing->new(user => $thing->{group});
+ $out->{touser} = $thing->{user} if $thing->{user};
+ $out->{group} = $thing->{origin};
+ } elsif ($thing->{touser} && DXChannel::get($thing->{touser})) {
+ $out = $thing->new(user => $thing->{touser});
+ $out->{group} = $thing->{group};
+ }
+ return $out;
+}
1;