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 3c4addd01c841ab41d54c45c63e779c0cb734128..d3b1e955411833567a8b2551c55e19d1616b4136 100644 (file)
@@ -29,8 +29,9 @@ use vars qw(%list %valid @ISA $max $filterdef);
                  users => '0,Users,parray',
                  usercount => '0,User Count',
                  version => '0,Version',
-                 np => '0,Using New Prot,yesno',
-                 lid => '0,Last Msgid',
+                 handle_xml => '0,Using XML,yesno',
+                 lastmsg => '0,Last Route Msg,atime',
+                 lastid => '0,Last Route MsgID',
 );
 
 $filterdef = $Route::filterdef;
@@ -224,7 +225,6 @@ sub new
        $self->{flags} = shift;
        $self->{users} = [];
        $self->{nodes} = [];
-       $self->{lid} = 0;
        
        $list{$call} = $self;
        
@@ -245,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;
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();