]> dxcluster.org Git - spider.git/commitdiff
get some basic XML routines up and running.
authorminima <minima>
Tue, 10 Jan 2006 22:22:21 +0000 (22:22 +0000)
committerminima <minima>
Tue, 10 Jan 2006 22:22:21 +0000 (22:22 +0000)
perl/DXProt.pm
perl/DXXml.pm
perl/DXXml/Dx.pm [new file with mode: 0644]
perl/DXXml/Ping.pm [new file with mode: 0644]
perl/IsoTime.pm [new file with mode: 0644]
perl/Route/Node.pm
perl/cluster.pl

index 352a4f6a4aae9bd715467aab117ad842bd295dd9..d51b9f1a7e256193985b0919f4523aec28d50957 100644 (file)
@@ -301,7 +301,7 @@ sub start
        $self->{pingave} = 999;
        $self->{metric} ||= 100;
        $self->{lastping} = $main::systime;
-
+       
        # send initialisation string
        unless ($self->{outbound}) {
                $self->sendinit;
@@ -335,6 +335,11 @@ sub normal
 {
        my ($self, $line) = @_;
 
+       if ($line =~ '^<\w+\s') {
+               DXXml::normal($self, $line);
+               return;
+       }
+
        my @field = split /\^/, $line;
        return unless @field;
        
@@ -1545,48 +1550,7 @@ sub handle_51
                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 {
 
@@ -1601,6 +1565,56 @@ sub handle_51
        }
 }
 
+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
 {
@@ -1711,7 +1725,8 @@ sub process
        }
 
        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
@@ -1725,6 +1740,7 @@ sub process
                                addping($main::mycall, $dxchan->call);
                                $dxchan->{nopings} -= 1;
                                $dxchan->{lastping} = $t;
+                               $dxchan->{lastping} += $dxchan->{pingint} / 2 unless @{$dxchan->{pingtime}};
                        }
                }
        }
index c6c8ee6922835d3c160789544878f30c1be61c0d..968b6148cf04f48d60e3564bd1292891eec19e37 100644 (file)
@@ -9,18 +9,34 @@
 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;
@@ -34,13 +50,79 @@ sub init
        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;
diff --git a/perl/DXXml/Dx.pm b/perl/DXXml/Dx.pm
new file mode 100644 (file)
index 0000000..d8bba23
--- /dev/null
@@ -0,0 +1,32 @@
+#
+# 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;
diff --git a/perl/DXXml/Ping.pm b/perl/DXXml/Ping.pm
new file mode 100644 (file)
index 0000000..26dd864
--- /dev/null
@@ -0,0 +1,32 @@
+#
+# 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;
diff --git a/perl/IsoTime.pm b/perl/IsoTime.pm
new file mode 100644 (file)
index 0000000..422f991
--- /dev/null
@@ -0,0 +1,89 @@
+#
+# 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;
index e7b18772eadeb0bc91fb99066de18ea40161ceb4..d3b1e955411833567a8b2551c55e19d1616b4136 100644 (file)
@@ -15,8 +15,10 @@ use Route::User;
 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);
@@ -27,9 +29,9 @@ use vars qw(%list %valid @ISA $max $filterdef);
                  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;
@@ -58,7 +60,7 @@ sub max
 # 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
@@ -66,21 +68,13 @@ 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;
 }
@@ -149,10 +143,10 @@ sub add_user
        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}};
@@ -204,25 +198,6 @@ sub parents
        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;
@@ -236,39 +211,6 @@ sub rnodes
        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
 {
@@ -279,11 +221,10 @@ 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;
        
@@ -304,22 +245,6 @@ sub get_all
        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;
@@ -358,6 +283,15 @@ sub _deluser
     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
 #
index e28011ab20165e221faaa05f7d19021175a9534b..0ad54f310b4bb7346e22e7194d920947c272fbd0 100755 (executable)
@@ -101,6 +101,7 @@ use QSL;
 use RouteDB;
 use DXXml;
 use DXSql;
+use IsoTime;
 
 use Data::Dumper;
 use IO::File;
@@ -134,7 +135,7 @@ $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;
-$main::build += 3;                             # fudge (put back for now)
+#$main::build += 2;                            # fudge (put back for now)
 
 
       
@@ -511,8 +512,10 @@ for (;;) {
        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();