Improve the selection of parser for XML::Simple.
authorminima <minima>
Sun, 15 Jan 2006 19:52:58 +0000 (19:52 +0000)
committerminima <minima>
Sun, 15 Jan 2006 19:52:58 +0000 (19:52 +0000)
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.

Changes
cmd/announce.pl
perl/DXLogPrint.pm
perl/DXUser.pm
perl/DXXml.pm
perl/DXXml/Ping.pm
perl/RingBuf.pm [new file with mode: 0644]
perl/create_sysop.pl

diff --git a/Changes b/Changes
index 47dd017cd5801bd08c1f26dbe4e47ef311412a18..dc5fbbefe5ec3165f350b84f974d11b2d18be5f5 100644 (file)
--- 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=======================================================================
index 6bad4af39449d256c7c023751e9c803181dc8c8b..a3ccb5b033d7f98dc8a9044212c40f0c3e38dcdc 100644 (file)
@@ -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++;
 }
 
index 752e72acd64aaa5470d0d3cae4cb619041d0ed4a..a968e53b1f818d18c9cb467faa1e6b6a98757e57 100644 (file)
@@ -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.
 #
index 13c5ba8101f55a66213d17be199e69901800710d..6ca9b91e5af7aff42fb73c28b08d220429194f11 100644 (file)
@@ -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;
index a351510c511f02ca0f8ce450bb3d3906c39f61c1..fe4cb2b8af8efc6affdc47079922e6f56f25e3c5 100644 (file)
@@ -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 $@;
 }
index 21662dae5a7a009a885c466d46e4c3dc2e19025f..06d96ff617cff373e0487dad01f8021dbbaa2ecf 100644 (file)
@@ -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 (file)
index 0000000..82b534e
--- /dev/null
@@ -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;
index 11673e3146f55694f654bd1b7771811e779d1fcf..b363b732634e8c0209a33e90d8b21f4395c99dac 100755 (executable)
@@ -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]/) {