From: minima <minima>
Date: Sun, 15 Jan 2006 19:52:58 +0000 (+0000)
Subject: Improve the selection of parser for XML::Simple.
X-Git-Tag: 1.53~79
X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=9cc26cc7a73efb7679d3e8e819ba0019307f8607;p=spider.git

Improve the selection of parser for XML::Simple.
Fix the problems introduced to Investigate's return pings not being
processed.
Fix sh/log's irritating habit of not showing (some of) the lines that we
want.
Speeded up sh/log by probably an order of magnitude.
---

diff --git a/Changes b/Changes
index 47dd017c..dc5fbbef 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,9 @@
+15Jan06=======================================================================
+1. Fix some obviously long standing problems with create_sysop.pl and also
+with initialising the User file.
+2. Fixed the problem with certain things not being shown in sh/log (because of
+a regex that rejected too many things).
+3. Speeded up sh/log quite a bit at the same time.
 14Jan06=======================================================================
 1. undo frequency rounding change, it causes more problems than it solves.
 11Jan06=======================================================================
diff --git a/cmd/announce.pl b/cmd/announce.pl
index 6bad4af3..a3ccb5b0 100644
--- a/cmd/announce.pl
+++ b/cmd/announce.pl
@@ -53,7 +53,7 @@ my $nossid = $from;
 my $drop = 0;
 $nossid =~ s/-\d+$//;
 if ($DXProt::badspotter->in($nossid)) {
-	LogDbg('DXCommand', "bad spotter ($from) made announcement: $line");
+	LogDbg('DXCommand', "bad spotter ($self->{call}) made announcement: $line");
 	$drop++;
 }
 
diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm
index 752e72ac..a968e53b 100644
--- a/perl/DXLogPrint.pm
+++ b/perl/DXLogPrint.pm
@@ -10,10 +10,11 @@ package DXLog;
 
 use IO::File;
 use DXVars;
-#use DXDebug ();
+use DXDebug qw(dbg isdbg);
 use DXUtil;
 use DXLog;
 use Julian;
+use RingBuf;
 
 use strict;
 
@@ -32,7 +33,7 @@ sub print
 {
 	my $fcb = $DXLog::log;
 	my $from = shift || 0;
-	my $to = shift || 20;
+	my $to = shift || 10;
 	my $jdate = $fcb->unixtoj(shift);
 	my $pattern = shift;
 	my $who = uc shift;
@@ -46,7 +47,7 @@ sub print
 	if ($pattern) {
 		$hint = "m{\\Q$pattern\\E}i";
 	} else {
-		$hint = "!m{ann|rcmd|talk|chat}";
+		$hint = "!m{\\^(?:ann|rcmd|talk|chat)\\^}";
 	}
 	if ($who) {
 		$hint .= ' && ' if $hint;
@@ -59,24 +60,30 @@ sub print
 	$eval = qq(while (<\$fh>) {
 				   $hint;
 				   chomp;
-				   push \@tmp, \$_;
+				   \$ring->write(\$_);
 			   } );
 	
+	if (isdbg('search')) {
+		dbg("sh/log hint: $hint");
+		dbg("sh/log eval: $eval");
+	}
+	
 	$fcb->close;                                      # close any open files
 
 	my $fh = $fcb->open($jdate); 
  L1: for (;@in < $to;) {
 		my $ref;
+		my $ring = RingBuf->new($tot);
+
 		if ($fh) {
 			my @tmp;
 			eval $eval;               # do the search on this file
 			return ("Log search error", $@) if $@;
-			@in = (@tmp, @in);
-			if (@in > $to) {
-				@in = splice @in, -$to, $to;
-				last L1;
-			} 
+			
+			@in = ($ring->readall, @in);
+			last L1 if @in > $tot;
 		}
+
 		$fh = $fcb->openprev();      # get the next file
 		last if !$fh;
 	}
@@ -88,6 +95,7 @@ sub print
 	return @out;
 }
 
+
 #
 # the standard log printing interpreting routine.
 #
diff --git a/perl/DXUser.pm b/perl/DXUser.pm
index 13c5ba81..6ca9b91e 100644
--- a/perl/DXUser.pm
+++ b/perl/DXUser.pm
@@ -141,7 +141,7 @@ sub init
 
 		$ufn = "$fn.v3";
 		$v3 = 1;
-		$convert++ unless -e $ufn;
+		$convert++ if -e "$fn.v2" && !-e $ufn;
 	}
 	
 	if ($mode) {
@@ -150,10 +150,12 @@ sub init
 		$dbm = tie (%u, 'DB_File', $ufn, O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_asc?]";
 	}
 
+	die "Cannot open $ufn ($!)\n" unless $dbm;
+
 	$lru = LRU->newbase("DXUser", $lrusize);
 	
 	# do a conversion if required
-	if ($convert) {
+	if ($dbm && $convert) {
 		my ($key, $val, $action, $count, $err) = ('','',0,0,0);
 		
 		my %oldu;
diff --git a/perl/DXXml.pm b/perl/DXXml.pm
index a351510c..fe4cb2b8 100644
--- a/perl/DXXml.pm
+++ b/perl/DXXml.pm
@@ -41,11 +41,17 @@ sub init
 {
 	return unless $main::do_xml;
 	
-	eval { require XML::Simple; };
-	unless ($@) {
+	eval { require XML::Simple };
+	eval { require XML::SAX } unless $@;
+	eval { require XML::SAX::Expat } unless $@;
+	if ($@) {
+		LogDbg('err', "do_xml was set to 1 and the XML routines failed to load ($@)");
+		$main::do_xml = 0;
+	} else {
+		$XML::Simple::PREFERRED_PARSER = 'XML::SAX::Expat';
 		import XML::Simple;
 		$DXProt::handle_xml = 1;
-		$xs = new XML::Simple();
+		$xs = new XML::Simple(Cache=>[]);
 	}
 	undef $@;
 }
diff --git a/perl/DXXml/Ping.pm b/perl/DXXml/Ping.pm
index 21662dae..06d96ff6 100644
--- a/perl/DXXml/Ping.pm
+++ b/perl/DXXml/Ping.pm
@@ -118,16 +118,9 @@ sub handle_ping_reply
 					$tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6);
 				}
 				$tochan->{nopings} = $nopings; # pump up the timer
-				if (my $ivp = Investigate::get($from, $fromdxchan->{call})) {
-					$ivp->handle_ping;
-				}
-			} elsif (my $rref = Route::Node::get($r->{to})) {
-				if (my $ivp = Investigate::get($from, $fromdxchan->{call})) {
-					$ivp->handle_ping;
-				}
 			}
-		}		
-		if ($dxchan->is_user) {
+			_handle_believe($from, $fromdxchan->{call});
+		} elsif ($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))
@@ -135,4 +128,18 @@ sub handle_ping_reply
 	}
 }
 
+sub _handle_believe
+{
+	my ($from, $via) = @_;
+	
+	if (my $ivp = Investigate::get($from, $via)) {
+		$ivp->handle_ping;
+	} else {
+		my $user = DXUser->get_current($from);
+		if ($user) {
+			$user->set_believe($via);
+			$user->put;
+		}
+	}
+}
 1;
diff --git a/perl/RingBuf.pm b/perl/RingBuf.pm
new file mode 100644
index 00000000..82b534e4
--- /dev/null
+++ b/perl/RingBuf.pm
@@ -0,0 +1,79 @@
+#
+# Finite size ring buffer creation and access routines
+#
+# Copyright (c) - 1998 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+use strict;
+
+package RingBuf;
+
+use vars qw($VERSION $BRANCH);
+$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;
+
+
+sub new
+{
+	my $pkg = shift;
+	my $size = shift;
+	return bless [$size, 0, 0, 0, 0, []], (ref $pkg || $pkg);
+}
+
+sub write
+{
+	my $self = shift;
+
+	$self->[5]->[$self->[2]++] = shift;
+	$self->[2] = 0 if $self->[2] >= $self->[0];
+	if ($self->[1] < $self->[0]) {
+		$self->[1] = ++$self->[1];
+	}
+	$self->[2] = $self->[2];
+	if ($self->[1] == $self->[0] && $self->[2] == $self->[3]) {
+		$self->[3] = $self->[2]+1;
+		$self->[3] = 0 if $self->[3] >= $self->[0]; 
+	}
+}
+
+sub read
+{
+	my $self = shift;
+	return unless $self->[1];
+	my $r;
+	
+	if ($self->[4] != $self->[2]) {
+		$r = $self->[5]->[$self->[4]++];
+		$self->[4] = 0 if $self->[4] >= $self->[0];
+	}
+	return $r;
+}
+
+sub rewind
+{
+	my $self = shift;
+	$self->[4] = $self->[3];
+}
+
+sub lth
+{
+	my $self = shift;
+	return $self->[1];
+}
+
+sub readall
+{
+	my $self = shift;
+	my @out;
+	
+	$self->rewind;
+	while (my $r = $self->read) {
+		push @out, $r;
+	}
+	return @out;
+}
+1;
diff --git a/perl/create_sysop.pl b/perl/create_sysop.pl
index 11673e31..b363b732 100755
--- a/perl/create_sysop.pl
+++ b/perl/create_sysop.pl
@@ -84,7 +84,9 @@ if (-e $lockfn) {
 	close CLLOCK;
 }
 
-if (-e "$userfn") {
+$DXUser::v3 = 1;
+
+if (-e "$userfn.v2" || -e "$userfn.v3") {
 	print "Do you wish to destroy your user database (THINK!!!) [y/N]: ";
 	$ans = <STDIN>;
 	if ($ans =~ /^[Yy]/) {