From f84b188c092d48648c16f3174b293b32d8f5bd6a Mon Sep 17 00:00:00 2001 From: minima Date: Sun, 15 Jan 2006 19:52:58 +0000 Subject: [PATCH] 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. --- Changes | 6 ++++ cmd/announce.pl | 2 +- perl/DXLogPrint.pm | 26 ++++++++++----- perl/DXUser.pm | 6 ++-- perl/DXXml.pm | 12 +++++-- perl/DXXml/Ping.pm | 25 +++++++++----- perl/RingBuf.pm | 79 ++++++++++++++++++++++++++++++++++++++++++++ perl/create_sysop.pl | 5 +-- 8 files changed, 135 insertions(+), 26 deletions(-) create mode 100644 perl/RingBuf.pm 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 f14cf6d2..b363b732 100755 --- a/perl/create_sysop.pl +++ b/perl/create_sysop.pl @@ -16,7 +16,6 @@ BEGIN { $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'}; unshift @INC, "$root/local"; - sub main::mkver {} } use DXVars; @@ -85,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 = ; if ($ans =~ /^[Yy]/) { -- 2.43.0