From: minima <minima>
Date: Tue, 10 Jan 2006 22:22:21 +0000 (+0000)
Subject: get some basic XML routines up and running.
X-Git-Tag: 1.53~91
X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=af378e74088394d9c70a9a01d67a311cf4774d96;p=spider.git

get some basic XML routines up and running.
---

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 352a4f6a..d51b9f1a 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -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}};
 			}
 		}
 	}
diff --git a/perl/DXXml.pm b/perl/DXXml.pm
index c6c8ee69..968b6148 100644
--- a/perl/DXXml.pm
+++ b/perl/DXXml.pm
@@ -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
index 00000000..d8bba23b
--- /dev/null
+++ b/perl/DXXml/Dx.pm
@@ -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
index 00000000..26dd864e
--- /dev/null
+++ b/perl/DXXml/Ping.pm
@@ -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
index 00000000..422f9912
--- /dev/null
+++ b/perl/IsoTime.pm
@@ -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;
diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm
index 3c4addd0..d3b1e955 100644
--- a/perl/Route/Node.pm
+++ b/perl/Route/Node.pm
@@ -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;
diff --git a/perl/cluster.pl b/perl/cluster.pl
index e28011ab..0ad54f31 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -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();