From dc305f992d75a6b35edda9e1aefab510a3ed617e Mon Sep 17 00:00:00 2001 From: minima Date: Mon, 9 Jan 2006 23:07:45 +0000 Subject: [PATCH] clean up various things and add the DXXml.pm module --- perl/DXChannel.pm | 1 + perl/DXProt.pm | 23 ++++------------------- perl/DXProtout.pm | 7 ++++--- perl/DXSql.pm | 1 + perl/DXUser.pm | 12 ------------ perl/DXXml.pm | 44 ++++++++++++++++++++++++++++++++++++++++++++ perl/Prefix.pm | 8 ++++---- perl/cluster.pl | 17 ++++++++++------- 8 files changed, 68 insertions(+), 45 deletions(-) create mode 100644 perl/DXXml.pm diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 09290121..6da3ecbe 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -117,6 +117,7 @@ $count = 0; ve7cc => '0,VE7CC program special,yesno', lastmsgpoll => '0,Last Msg Poll,atime', inscript => '9,In a script,yesno', + handle_xml => '9,Handles XML,yesno', inqueue => '9,Input Queue,parray', ); diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 7f30ae62..39b023c4 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -50,7 +50,8 @@ use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restim $pingint $obscount %pc19list $chatdupeage $chatimportfn $investigation_int $pc19_version $myprot_version %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck - $allowzero $decode_dk0wcy $send_opernam @checklist); + $allowzero $decode_dk0wcy $send_opernam @checklist + $handle_xml); $pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11 $pc23_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc23 @@ -78,6 +79,7 @@ $chatdupeage = 20 * 60 * 60; $chatimportfn = "$main::root/chat_import"; $investigation_int = 12*60*60; # time between checks to see if we can see this node $pc19_version = 5466; # the visible version no for outgoing PC19s generated from pc59 +$handle_xml = 0; # handle XML sentences @checklist = ( @@ -326,21 +328,6 @@ sub sendinit $self->send(pc18()); } -sub removepc90 -{ - $_[0] =~ s/^PC90\^[-A-Z0-9]+\^\d+\^//; - $_[0] =~ s/^PC91\^[-A-Z0-9]+\^\d+\^[-A-Z0-9]+\^//; -} - -#sub send -#{ -# my $self = shift; -# while (@_) { -# my $line = shift; -# $self->SUPER::send($line); -# } -#} - # # This is the normal pcxx despatcher # @@ -348,9 +335,6 @@ sub normal { my ($self, $line) = @_; - # remove any incoming PC90 frames - removepc90($line); - my @field = split /\^/, $line; return unless @field; @@ -946,6 +930,7 @@ sub handle_18 $self->user->put; $self->sort('S'); } + $self->handle_xml++ if $_[1] =~ /\bxml\b/; } else { $self->version(50.0); $self->version($_[2] / 100) if $_[2] && $_[2] =~ /^\d+$/; diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index a5498a0c..31c9a7fc 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -25,10 +25,10 @@ $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)) $main::build += $VERSION; $main::branch += $BRANCH; -use vars qw($sentencelth); +use vars qw($sentencelth $handle_xml); $sentencelth = 180; - + # # All the PCxx generation routines # @@ -123,7 +123,8 @@ sub pc17 # Request init string sub pc18 { - return "PC18^DXSpider Version: $main::version Build: $main::build^$DXProt::myprot_version^"; + my $flags = " xml" if $handle_xml; + return "PC18^DXSpider Version: $main::version Build: $main::build$flags^$DXProt::myprot_version^"; } # diff --git a/perl/DXSql.pm b/perl/DXSql.pm index a2194a7b..5d45eb94 100644 --- a/perl/DXSql.pm +++ b/perl/DXSql.pm @@ -31,6 +31,7 @@ sub init import DBI; $active++; } + undef $@; return $active; } diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 6e2c014e..13c5ba81 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -78,8 +78,6 @@ $v3 = 0; wantlogininfo => '0,Login Info Req,yesno', wantgrid => '0,Show DX Grid,yesno', wantann_talk => '0,Talklike Anns,yesno', - wantpc90 => '1,Req PC90,yesno', - wantnp => '1,Req New Proto,yesno', wantpc16 => '9,Want Users from node,yesno', wantsendpc16 => '9,Send PC16,yesno', wantroutepc19 => '9,Route PC19,yesno', @@ -686,11 +684,6 @@ sub wantpc16 return _want('pc16', @_); } -sub wantpc90 -{ - return _wantnot('pc90', @_); -} - sub wantsendpc16 { return _want('sendpc16', @_); @@ -716,11 +709,6 @@ sub wantdxitu return _want('dxitu', @_); } -sub wantnp -{ - return _wantnot('np', @_); -} - sub wantlogininfo { my $self = shift; diff --git a/perl/DXXml.pm b/perl/DXXml.pm new file mode 100644 index 00000000..16f40eaa --- /dev/null +++ b/perl/DXXml.pm @@ -0,0 +1,44 @@ +# +# XML handler +# +# $Id$ +# +# Copyright (c) Dirk Koopman, G1TLH +# + +use strict; + +package DXXml; + +use DXChannel; +use DXProt; + +use vars qw($VERSION $BRANCH $xs); +$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 + +sub init +{ + eval { require XML::Simple; }; + unless ($@) { + import XML::Simple; + $DXProt::handle_xml = 1; + $xs = new XML::Simple(); + } + undef $@; +} + +sub normal +{ + +} + +sub process +{ + +} +1; diff --git a/perl/Prefix.pm b/perl/Prefix.pm index 3f1341ad..da173ce1 100644 --- a/perl/Prefix.pm +++ b/perl/Prefix.pm @@ -76,10 +76,10 @@ sub load } # tie the main prefix database - $db = tie(%pre, "DB_File", undef, O_RDWR|O_CREAT, 0664, $DB_BTREE) or confess "can't tie \%pre ($!)"; - my $out = $@ if $@; - do "$main::data/prefix_data.pl" if !$out; - $out = $@ if $@; + eval {$db = tie(%pre, "DB_File", undef, O_RDWR|O_CREAT, 0664, $DB_BTREE);}; + my $out = "$@($!)" if !$db || $@ ; + eval {do "$main::data/prefix_data.pl" if !$out; }; + $out .= $@ if $@; $lru = LRU->newbase('Prefix', $lrusize); return $out; diff --git a/perl/cluster.pl b/perl/cluster.pl index 80c4a057..003ae845 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -102,6 +102,7 @@ use QSL; use Thingy; use RouteDB; use AMsg; +use DXXml; use Data::Dumper; use IO::File; @@ -349,13 +350,6 @@ STDOUT->autoflush(1); $build += $main::version; $build = "$build.$branch" if $branch; -LogDbg('cluster', "DXSpider V$version, build $build started"); - -# banner -my ($year) = (gmtime)[5]; -$year += 1900; -dbg("Copyright (c) 1998-$year Dirk Koopman G1TLH"); - # try to load the database if ($dsn && -e "$root/perl/DXSql.pm") { require DXSql; @@ -367,6 +361,15 @@ if ($dsn && -e "$root/perl/DXSql.pm") { } } +# try to load XML::Simple +DXXml::init(); + +# banner +my ($year) = (gmtime)[5]; +$year += 1900; +LogDbg('cluster', "DXSpider V$version, build $build started"); +dbg("Copyright (c) 1998-$year Dirk Koopman G1TLH"); + # load Prefixes dbg("loading prefixes ..."); dbg(USDB::init()); -- 2.34.1