a few changes after profiling

diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index a000e17ac4657159c5a212514cf9c31a1320a53f..895a47b14d655ff7c6f3dd66d93d02ea757104d2 100644 (file)
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -696,40 +696,46 @@ sub broadcast_list
        }
 }
 
-sub process
+sub process_one
 {
-       foreach my $dxchan (get_all()) {
-               next if $dxchan->{disconnecting};
+       my $self = shift;
+
+       while (my $data = shift @{$self->{inqueue}}) {
+               my ($sort, $call, $line) = $self->decode_input($data);
+               next unless defined $sort;
+               
+               # do the really sexy console interface bit! (Who is going to do the TK interface then?)
+               dbg("<- $sort $call $line") if $sort ne 'D' && isdbg('chan');
                
-               while (my $data = shift @{$dxchan->{inqueue}}) {
-                       my ($sort, $call, $line) = $dxchan->decode_input($data);
-                       next unless defined $sort;
-
-                       # do the really sexy console interface bit! (Who is going to do the TK interface then?)
-                       dbg("<- $sort $call $line") if $sort ne 'D' && isdbg('chan');
-
-                       # handle A records
-                       my $user = $dxchan->user;
-                       if ($sort eq 'A' || $sort eq 'O') {
-                               $dxchan->start($line, $sort);
-                       } elsif ($sort eq 'I') {
-                               die "\$user not defined for $call" if !defined $user;
+               # handle A records
+               my $user = $self->user;
+               if ($sort eq 'A' || $sort eq 'O') {
+                       $self->start($line, $sort);
+               } elsif ($sort eq 'I') {
+                       die "\$user not defined for $call" if !defined $user;
                        
-                               # normal input
-                               $dxchan->normal($line);
-                       } elsif ($sort eq 'Z') {
-                               $dxchan->disconnect;
-                       } elsif ($sort eq 'D') {
-                               ;                               # ignored (an echo)
-                       } elsif ($sort eq 'G') {
-                               $dxchan->enhanced($line);
-                       } else {
-                               print STDERR atime, " Unknown command letter ($sort) received from $call\n";
-                       }
+                       # normal input
+                       $self->normal($line);
+               } elsif ($sort eq 'Z') {
+                       $self->disconnect;
+               } elsif ($sort eq 'D') {
+                       ;                               # ignored (an echo)
+               } elsif ($sort eq 'G') {
+                       $self->enhanced($line);
+               } else {
+                       dbg atime . " Unknown command letter ($sort) received from $call\n";
                }
        }
 }
 
+sub process
+{
+       foreach my $dxchan (get_all()) {
+               next if $dxchan->{disconnecting};
+               $dxchan->process_one;
+       }
+}
+
 sub handle_xml
 {
        my $self = shift;

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 1e3efc47fd97bc6ecae12f506bcca9b3ede6f857..6f01eb574f54dd618a083a30e0f1a6306b5218de 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -564,7 +564,7 @@ sub process
        my $dxchan;
        
        foreach $dxchan (@dxchan) {
-               next if $dxchan->sort ne 'U';  
+               next if $dxchan->{sort} ne 'U';  
        
                # send a outstanding message prompt if required
                if ($t >= $dxchan->lastmsgpoll + $msgpolltime) {
@@ -1166,6 +1166,9 @@ sub import_cmd
        my @names = readdir(DIR);
        closedir(DIR);
        my $name;
+
+       return unless @names;
+       
        foreach $name (@names) {
                next if $name =~ /^\./;
 

diff --git a/perl/cluster.pl b/perl/cluster.pl
index f100d4078f3b1440686a754aa512aee04bd18ff0..c13d93a1df72b3238e7b23011e96b956434789df 100755 (executable)
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -341,6 +341,7 @@ sub idle_loop
 {
        my $timenow = time;
 
+       BPQMsg::process();
        DXChannel::process();
 
        #      $DB::trace = 0;
@@ -364,23 +365,16 @@ sub idle_loop
                DXDb::process();
                DXUser::process();
                DXDupe::process();
-               $systime_days = $days;
-               $systime_daystart = $days * 86400;
-       }
-       IsoTime::update($systime);
-       DXCron::process();                      # do cron jobs
-       DXCommandmode::process();       # process ongoing command mode stuff
-       DXXml::process();
-       DXProt::process();                      # process ongoing ak1a pcxx stuff
-       DXConnect::process();
-       DXMsg::process();
-       DXDb::process();
-       DXUser::process();
-       DXDupe::process();
-       AGWMsg::process();
-       BPQMsg::process();
+               DXCron::process();                      # do cron jobs
+               IsoTime::update($systime);
+               DXProt::process();                      # process ongoing ak1a pcxx stuff
+               DXConnect::process();
+               DXUser::process();
+               AGWMsg::process();
+               
+               Timer::handler();
 
-       Timer::handler();
+       }
 
        if (defined &Local::process) {
                eval {