$self->{pingave} = 999;
$self->{metric} ||= 100;
$self->{lastping} = $main::systime;
-
+
# send initialisation string
unless ($self->{outbound}) {
$self->sendinit;
{
my ($self, $line) = @_;
+ if ($line =~ '^<\w+\s') {
+ DXXml::normal($self, $line);
+ return;
+ }
+
my @field = split /\^/, $line;
return unless @field;
if ($flag == 1) {
$self->send(pc51($from, $to, '0'));
} else {
- # it's a reply, look in the ping list for this one
- my $ref = $pings{$from};
- if ($ref) {
- my $tochan = DXChannel::get($from);
- while (@$ref) {
- my $r = shift @$ref;
- my $dxchan = DXChannel::get($r->{call});
- next unless $dxchan;
- my $t = tv_interval($r->{t}, [ gettimeofday ]);
- if ($dxchan->is_user) {
- my $s = sprintf "%.2f", $t;
- my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t;
- $dxchan->send($dxchan->msg('pingi', $from, $s, $ave))
- } elsif ($dxchan->is_node) {
- if ($tochan) {
- my $nopings = $tochan->user->nopings || $obscount;
- push @{$tochan->{pingtime}}, $t;
- shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6;
-
- # cope with a missed ping, this means you must set the pingint large enough
- if ($t > $tochan->{pingint} && $t < 2 * $tochan->{pingint} ) {
- $t -= $tochan->{pingint};
- }
-
- # calc smoothed RTT a la TCP
- if (@{$tochan->{pingtime}} == 1) {
- $tochan->{pingave} = $t;
- } else {
- $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6);
- }
- $tochan->{nopings} = $nopings; # pump up the timer
- if (my $ivp = Investigate::get($from, $self->{call})) {
- $ivp->handle_ping;
- }
- } elsif (my $rref = Route::Node::get($r->{call})) {
- if (my $ivp = Investigate::get($from, $self->{call})) {
- $ivp->handle_ping;
- }
- }
- }
- }
- }
+ $self->handle_ping_reply($from);
}
} else {
}
}
+sub handle_ping_reply
+{
+ my $self = shift;
+ my $from = shift;
+ my $id = shift;
+
+ # it's a reply, look in the ping list for this one
+ my $ref = $pings{$from};
+ return unless $ref;
+
+ my $tochan = DXChannel::get($from);
+ while (@$ref) {
+ my $r = shift @$ref;
+ my $dxchan = DXChannel::get($r->{call});
+ next unless $dxchan;
+ my $t = tv_interval($r->{t}, [ gettimeofday ]);
+ if ($dxchan->is_user) {
+ my $s = sprintf "%.2f", $t;
+ my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t;
+ $dxchan->send($dxchan->msg('pingi', $from, $s, $ave))
+ } elsif ($dxchan->is_node) {
+ if ($tochan) {
+ my $nopings = $tochan->user->nopings || $obscount;
+ push @{$tochan->{pingtime}}, $t;
+ shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6;
+
+ # cope with a missed ping, this means you must set the pingint large enough
+ if ($t > $tochan->{pingint} && $t < 2 * $tochan->{pingint} ) {
+ $t -= $tochan->{pingint};
+ }
+
+ # calc smoothed RTT a la TCP
+ if (@{$tochan->{pingtime}} == 1) {
+ $tochan->{pingave} = $t;
+ } else {
+ $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6);
+ }
+ $tochan->{nopings} = $nopings; # pump up the timer
+ if (my $ivp = Investigate::get($from, $self->{call})) {
+ $ivp->handle_ping;
+ }
+ } elsif (my $rref = Route::Node::get($r->{call})) {
+ if (my $ivp = Investigate::get($from, $self->{call})) {
+ $ivp->handle_ping;
+ }
+ }
+ }
+ }
+}
+
# dunno but route it
sub handle_75
{
}
foreach $dxchan (@dxchan) {
- next unless $dxchan->is_node();
+ next unless $dxchan->is_node;
+ next if $dxchan->handle_xml;
next if $dxchan == $main::me;
# send the pc50
addping($main::mycall, $dxchan->call);
$dxchan->{nopings} -= 1;
$dxchan->{lastping} = $t;
+ $dxchan->{lastping} += $dxchan->{pingint} / 2 unless @{$dxchan->{pingtime}};
}
}
}
use strict;
package DXXml;
+use IsoTime;
-use DXChannel;
use DXProt;
+use DXDebug;
+use DXLog;
+use DXXml::Ping;
+use DXXml::Dx;
-use vars qw($VERSION $BRANCH $xs);
+use vars qw($VERSION $BRANCH $xs $id);
$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0));
$main::build += $VERSION;
$main::branch += $BRANCH;
-$xs = undef; # the XML::Simple parser instance
+$xs = undef; # the XML::Simple parser instance
+$id = 0; # the next ID to be used
+# generate a new XML sentence structure
+sub new
+{
+ my $pkg = shift;
+ my $class = ref $pkg || $pkg;
+ return bless{@_}, $class;
+}
+
+#
+# note that this a function not a method
+#
sub init
{
return unless $main::do_xml;
undef $@;
}
+#
+# note that this a function not a method
+#
sub normal
{
+ my $dxchan = shift;
+ my $line = shift;
+
+ unless ($main::do_xml) {
+ dbg("xml not enabled, IGNORED") if isdbg('chanerr');
+ return;
+ }
+
+ my ($rootname) = $line =~ '<(\w+) ';
+ my $pkg = "DXXml::" . ucfirst lc "$rootname";
+
+ unless (defined *{"${pkg}::"} && $pkg->can('handle_input')) {
+ dbg("xml sentence $rootname not recognised, IGNORED") if isdbg('chanerr');
+ return;
+ }
+
+ my $xref;
+ unless ($xref = $pkg->decode_xml($dxchan, $line)) {
+ dbg("invalid XML ($@), IGNORED") if isdbg('chanerr');
+ undef $@;
+ return;
+ }
+
+ # mark the handle as accepting xml (but only if they
+ # have at least one right)
+ $dxchan->handle_xml(1);
+ $xref = bless $xref, $pkg;
+ $xref->{'-xml'} = $line;
+ $xref->handle_input($dxchan);
}
+#
+# note that this a function not a method
+#
sub process
{
}
+
+sub decode_xml
+{
+ my $pkg = shift;
+ my $dxchan = shift;
+ my $line = shift;
+
+ my $xref;
+ eval {$xref = $xs->XMLin($line)};
+ return $xref;
+}
+
+sub nextid
+{
+ my $r = $id++;
+ $id = 0 if $id > 999;
+ return $r;
+}
+
+sub toxml
+{
+ my $self = shift;
+
+ $self->{o} ||= $main::mycall;
+ $self->{t} ||= IsoTime::dayms();
+ $self->{id} ||= nextid();
+
+ my ($name) = ref $self =~ /::(\w+)$/;
+ my $s = $xs->XMLout($self, RootName =>$name, NumericEscape=>1);
+ return $self->{'-xml'} = $s;
+}
1;
--- /dev/null
+#
+# XML DX Spot handler
+#
+# $Id$
+#
+# Copyright (c) Dirk Koopman, G1TLH
+#
+
+use strict;
+
+package DXXml::Dx;
+
+use DXDebug;
+use DXProt;
+use IsoTime;
+
+use vars qw($VERSION $BRANCH @ISA);
+$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
+$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0));
+$main::build += $VERSION;
+$main::branch += $BRANCH;
+
+@ISA = qw(DXXml);
+
+sub handle_input
+{
+ my $self = shift;
+ my $dxchan = shift;
+
+}
+
+1;
--- /dev/null
+#
+# XML Ping handler
+#
+# $Id$
+#
+# Copyright (c) Dirk Koopman, G1TLH
+#
+
+use strict;
+
+package DXXml::Ping;
+
+use DXDebug;
+use DXProt;
+use IsoTime;
+
+use vars qw($VERSION $BRANCH @ISA);
+$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
+$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0));
+$main::build += $VERSION;
+$main::branch += $BRANCH;
+
+@ISA = qw(DXXml);
+
+sub handle_input
+{
+ my $self = shift;
+ my $dxchan = shift;
+
+}
+
+1;
--- /dev/null
+#
+# Utility routines for handling Iso 8601 date time groups
+#
+# $Id$
+#
+# Copyright (c) Dirk Koopman, G1TLH
+#
+
+use strict;
+
+package IsoTime;
+
+use Date::Parse;
+
+use vars qw($VERSION $BRANCH $year $month $day $hour $min $sec @days @ldays);
+$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
+$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0));
+$main::build += $VERSION;
+$main::branch += $BRANCH;
+
+@days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+@ldays = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+
+# is it a leap year?
+sub _isleap
+{
+ my $year = shift;
+ return ($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) ? 1 : 0;
+}
+
+sub full
+{
+ return sprintf "%04d%02d%02dT%02d%02d%02d", $year, $month, $day, $hour, $min, $sec;
+}
+
+sub dayminsec
+{
+ return sprintf "%02dT%02d%02d%02d", $day, $hour, $min, $sec;
+}
+
+sub daymin
+{
+ return sprintf "%02dT%02d%02d", $day, $hour, $min;
+}
+
+sub update
+{
+ my $t = shift || time;
+ ($sec,$min,$hour,$day,$month,$year) = gmtime($t);
+ $month++;
+ $year += 1900;
+}
+
+sub unixtime
+{
+ my $iso = shift;
+
+ # get the correct month and year if it is a short date
+ if (my ($d) = $iso =~ /^(\d\d)T\d\d\d\d/) {
+ if ($d == $day) {
+ $iso = sprintf("%04d%02d", $year, $month) . $iso;
+ } else {
+ my $days = _isleap($year) ? $ldays[$month-1] : $days[$month-1];
+ my ($y, $m) = ($year, $month);
+ if ($d < $day) {
+ if ($day - $d > $days / 2) {
+ if ($month == 1) {
+ $y = $year - 1;
+ $m = 12;
+ } else {
+ $m = $month - 1;
+ }
+ }
+ } else {
+ if ($d - $day > $days / 2) {
+ if ($month == 12) {
+ $y = $year + 1;
+ $m = 1;
+ } else {
+ $m = $month + 1;
+ }
+ }
+ }
+ $iso = sprintf("%04d%02d", $y, $m) . $iso;
+ }
+ }
+ return str2time($iso);
+}
+1;
use strict;
use vars qw($VERSION $BRANCH);
-
-main::mkver($VERSION = q$Revision$);
+$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
+$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0));
+$main::build += $VERSION;
+$main::branch += $BRANCH;
use vars qw(%list %valid @ISA $max $filterdef);
@ISA = qw(Route);
users => '0,Users,parray',
usercount => '0,User Count',
version => '0,Version',
- build => '0,Build',
- sw => '0,Software',
- np => '0,Using New Prot,yesno',
+ handle_xml => '0,Using XML,yesno',
+ lastmsg => '0,Last Route Msg,atime',
+ lastid => '0,Last Route MsgID',
);
$filterdef = $Route::filterdef;
# object with that callsign. The upper layers are expected to do something
# sensible with this!
#
-# called as $parent->add(call, version, flags)
+# called as $parent->add(call, dxchan, version, flags)
#
sub add
my $parent = shift;
my $call = uc shift;
confess "Route::add trying to add $call to myself" if $call eq $parent->{call};
- my $version = shift;
- my $here = shift;
-
my $self = get($call);
if ($self) {
$self->_addparent($parent);
$parent->_addnode($self);
- if ($self->{version} != $version || $self->{flags} != $here) {
- $self->{version} = $version;
- $self->{flags} = $here;
- return $self;
- }
return undef;
}
- $self = $parent->new($call, $version, $here);
+ $self = $parent->new($call, @_);
$parent->_addnode($self);
return $self;
}
my $uref = Route::User::get($ucall);
my @out;
if ($uref) {
- push @out, $uref->addparent($self);
+ @out = $uref->addparent($self);
} else {
$uref = Route::User->new($ucall, $self->{call}, @_);
- push @out, $uref;
+ @out = $uref;
}
$self->_adduser($uref);
$self->{usercount} = scalar @{$self->{users}};
return @{$self->{parent}};
}
-sub has_user
-{
- my $self = shift;
- return $self->_haslist('users', shift);
-}
-
-sub has_node
-{
- my $self = shift;
- return $self->_haslist('nodes', shift);
-}
-
-sub has_parent
-{
- my $self = shift;
- return $self->_haslist('parent', shift);
-}
-
-
sub rnodes
{
my $self = shift;
return @out;
}
-# return the differences in nodes between what we currently have and
-# the list proffered. Returns two refs one to a list of nodes to remove and
-# the other a list of nodes to add
-#
-# input is a list of callsigns (not refs)
-sub diff_nodes
-{
- my $self = shift;
- my $in = ref $_[0] ? shift : \@_;
- my %del = map {($_, 1)} nodes($self);
- my %in = map {($_, 1)} @$in;
-
- # remove all the calls that are in both lists
- for (@$in) {
- delete $in{$_} if delete $del{$_};
- }
- return ([keys %del], [keys %in]);
-}
-
-# same as above but for users
-sub diff_users
-{
- my $self = shift;
- my $in = ref $_[0] ? shift : \@_;
- my %del = map {($_, 1)} users($self);
- my %in = map {($_, 1)} @$in;
-
- # remove all the calls that are in both lists
- for (@$in) {
- delete $in{$_} if delete $del{$_};
- }
- return ([keys %del], [keys %in]);
-}
sub new
{
my $self = $pkg->SUPER::new($call);
$self->{parent} = ref $pkg ? [ $pkg->{call} ] : [ ];
- $self->{version} = 0 || shift;
- $self->{flags} = 0 || shift;
+ $self->{version} = shift;
+ $self->{flags} = shift;
$self->{users} = [];
$self->{nodes} = [];
- $self->{lid} = 0;
$list{$call} = $self;
return values %list;
}
-sub newid
-{
- my $self = shift;
- my $id = shift;
-
- return 0 if $id == $self->{lid};
- if ($id > $self->{lid}) {
- $self->{lid} = $id;
- return 1;
- } elsif ($self->{lid} - $id > 500) {
- $self->{id} = $id;
- return 1;
- }
- return 0;
-}
-
sub _addparent
{
my $self = shift;
return $self->_dellist('users', @_);
}
+sub DESTROY
+{
+ my $self = shift;
+ my $pkg = ref $self;
+ my $call = $self->{call} || "Unknown";
+
+ dbg("destroying $pkg with $call") if isdbg('routelow');
+}
+
#
# generic AUTOLOAD for accessors
#
use RouteDB;
use DXXml;
use DXSql;
+use IsoTime;
use Data::Dumper;
use IO::File;
$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0));
$main::build += $VERSION;
$main::branch += $BRANCH;
-$main::build += 3; # fudge (put back for now)
+#$main::build += 2; # fudge (put back for now)
if ($timenow != $systime) {
reap if $zombies;
$systime = $timenow;
+ IsoTime::update($systime);
DXCron::process(); # do cron jobs
DXCommandmode::process(); # process ongoing command mode stuff
+ DXXml::process();
DXProt::process(); # process ongoing ak1a pcxx stuff
DXConnect::process();
DXMsg::process();
projects / spider.git / commitdiff