clean up various things and add the DXXml.pm module

diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 09290121b88114169eb10045ffd1ab13a4c0cea5..6da3ecbe36d0be30a00ee2a47ce64bdac9f1e411 100644 (file)
--- 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 7f30ae62acd446da059cc45283cfe8e6af00bdfe..39b023c482705163e1be93f84e256766cbffcfa9 100644 (file)
--- 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 a5498a0c8a45568675d23eb7fc5fea38094dd3e3..31c9a7fc75a8215f76bf0a237ab8dfaf91627328 100644 (file)
--- 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 a2194a7b2f7618a06f0ba10a1b1064f69f22e0d5..5d45eb94ea68108ba6b2e023f7edb32906981893 100644 (file)
--- 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 6e2c014e80febe2efcd84be9afc6d08b9a67da3e..13c5ba8101f55a66213d17be199e69901800710d 100644 (file)
--- 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 (file)
index 0000000..16f40ea
--- /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 3f1341ad6fd169bbbf5a8ceaee42b214fab1e945..da173ce175eb631a55bdfe50cf245869c9542279 100644 (file)
--- 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 80c4a0573cb62899fa408826b0f46e7563677af1..003ae845becc11c9f73a8292333bfb91e17748c0 100755 (executable)
--- 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());