mv HTTPMsg to AsyncMsg, add 'raw' method

[spider.git] / perl / DXCommandmode.pm

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 6fde1742b6067b8b3b1d717bfdbe073b51c5c29f..ad9baad05832ed2d087ee479f1d9a84a52acb519 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -32,11 +32,11 @@ use WCY;
 use Sun;
 use Internet;
 use Script;
-use Net::Telnet;
 use QSL;
 use DB_File;
 use VE7CC;
 use DXXml;
+use AsyncMsg;
 
 use strict;
 use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase %nothereslug
@@ -51,7 +51,7 @@ $maxbadcount = 3;                             # no of bad words allowed before disconnection
 $msgpolltime = 3600;                   # the time between polls for new messages 
 $cmdimportdir = "$main::root/cmd_import"; # the base directory for importing command scripts 
                                           # this does not exist as default, you need to create it manually
-                                         #
+#
 
 #
 # obtain a new connection this is derived from dxchannel
@@ -65,7 +65,7 @@ sub new
        my $pkg = shift;
        my $call = shift;
 #      my @rout = $main::routeroot->add_user($call, Route::here(1));
-       DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1]);
+       DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1, undef, undef, $self->{conn}->peerhost], );
 
        # ALWAYS output the user
        my $ref = Route::User::get($call);
@@ -89,7 +89,7 @@ sub start
        my $name = $user->{name};
        
        # log it
-       my $host = $self->{conn}->{peerhost};
+       my $host = $self->{conn}->peerhost;
        $host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport};
        $host ||= "unknown";
        LogDbg('DXCommand', "$call connected from $host");
@@ -521,10 +521,10 @@ sub run_cmd
                        my $package = find_cmd_name($path, $fcmd);
                        return ($@) if $@;
                                
-                       if ($package && DXCommandmode->can($package)) {
+                       if ($package && $self->can("${package}::handle")) {
                                no strict 'refs';
                                dbg("cmd: package $package") if isdbg('command');
-                               eval { @ans = &$package($self, $args) };
+                               eval { @ans = &{"${package}::handle"}($self, $args) };
                                return (DXDebug::shortmess($@)) if $@;
                        } else {
                                dbg("cmd: $package not present") if isdbg('command');
@@ -745,12 +745,14 @@ sub clear_cmd_cache
 {
        no strict 'refs';
        
-       for (keys %Cache) {
-               undef *{$_} unless /cmd_cache/;
-               dbg("Undefining cmd $_") if isdbg('command');
+       for my $k (keys %Cache) {
+               unless ($k =~ /cmd_cache/) {
+                       dbg("Undefining cmd $k") if isdbg('command');
+                       undef $DXCommandmode::{"${k}::"};
+               }
        }
        %cmd_cache = ();
-       %Cache = ();
+       %Cache = ( cmd_clear_cmd_cache  => $Cache{cmd_clear_cmd_cache} );
 }
 
 #
@@ -761,11 +763,10 @@ sub clear_cmd_cache
 # 
 # This has been nicked directly from the perlembed pages
 #
-
 #require Devel::Symdump;  
 
 sub valid_package_name {
-       my($string) = @_;
+       my $string = shift;
        $string =~ s|([^A-Za-z0-9_/])|sprintf("_%2x",unpack("C",$1))|eg;
        
        $string =~ s|/|_|g;
@@ -788,7 +789,7 @@ sub find_cmd_name {
                return undef;
        }
        
-       if(defined $Cache{$package}->{mtime} &&$Cache{$package}->{mtime} <= $mtime) {
+       if(exists $Cache{$package} && exists $Cache{$package}->{mtime} && $Cache{$package}->{mtime} <= $mtime) {
                #we have compiled this subroutine already,
                #it has not been updated on disk, nothing left to do
                #print STDERR "already compiled $package->handler\n";
@@ -802,7 +803,14 @@ sub find_cmd_name {
                };
                
                #wrap the code into a subroutine inside our unique package
-               my $eval = qq( sub $package { $sub } );
+               my $eval = qq(package DXCommandmode::$package; use POSIX qw{:math_h}; use DXLog; use DXDebug; use DXUser; use DXUtil; our \@ISA = qw{DXCommandmode}; );
+
+
+               if ($sub =~ m|\s*sub\s+handle\n|) {
+                       $eval .= $sub;
+               } else {
+                       $eval .= qq(sub handle { $sub });
+               }
                
                if (isdbg('eval')) {
                        my @list = split /\n/, $eval;
@@ -817,7 +825,8 @@ sub find_cmd_name {
 
                if (exists $Cache{$package}) {
                        dbg("find_cmd_name: Redefining $package") if isdbg('command');
-                       undef *$package;
+                       undef $DXCommandmode::{"${package}::"};
+                       delete $Cache{$package};
                } else {
                        dbg("find_cmd_name: Defining $package") if isdbg('command');
                }
@@ -825,10 +834,9 @@ sub find_cmd_name {
                eval $eval;
 
                $Cache{$package} = {mtime => $mtime } unless $@;
-           
        }
 
-       return $package;
+       return "DXCommandmode::$package";
 }
 
 sub send
@@ -1224,7 +1232,7 @@ sub send_motd
        }
        $motd = "${main::motd}_$self->{lang}" unless $motd && -e $motd;
        $motd = $main::motd unless $motd && -e $motd;
-       if ($self->conn->{csort} eq 'ax25') {
+       if ($self->conn->ax25) {
                if ($motd) {
                        $motd = "${motd}_ax25" if -e "${motd}_ax25";
                } else {