]> dxcluster.org Git - spider.git/commitdiff
add DXCommand::spawn_cmd and convert suitable cmds
authorDirk Koopman <djk@tobit.co.uk>
Tue, 17 Jun 2014 19:43:02 +0000 (20:43 +0100)
committerDirk Koopman <djk@tobit.co.uk>
Tue, 17 Jun 2014 19:43:02 +0000 (20:43 +0100)
All file searching commands (that I can think of) now spawn jobs
(one per cmd [to be changed?]) rather than do it in line.

This affects sh/log (and friends) and sh/dx (and friends)

cmd/Aliases
cmd/show/announce.pl
cmd/show/chat.pl
cmd/show/dx.pl
cmd/show/groups.pl
cmd/show/log.pl
cmd/show/rcmd.pl
cmd/show/talk.pl
perl/DXCommandmode.pm
perl/DXLogPrint.pm
perl/cluster.pl

index 84b4c18276b71f7d854f22ebd4ee62e53d65fc30..f391a850fca10c1d81beea3135f4733dce43b2ba 100644 (file)
@@ -126,7 +126,8 @@ package CmdAlias;
          '^sho?w?/fdx/(\d+)', 'show/dx real $1', 'show/fdx',
          '^sho?w?/fdx/d(\d+)', 'show/dx real from $1', 'show/fdx',
          '^sho?w?/fdx', 'show/dx real', 'show/fdx',
-         '^sho?w?/gre?y?l?i?n?e?', 'show/grayline', 'show/grayline',
+         '^sho?w?/grou?p?s?', 'show/groups', 'show/groups',
+         '^sho?w?/gr[ae]?y?l?i?n?e?', 'show/grayline', 'show/grayline',
          '^sho?w?/myfd?x?/(\d+)-(\d+)', 'show/dx filter real $1-$2', 'show/mydx',
          '^sho?w?/myfd?x?/(\d+)', 'show/dx filter real $1', 'show/mydx',
          '^sho?w?/myfd?x?/d(\d+)', 'show/dx filter real from $1', 'show/mydx',
index 9ec0111b3cc491671ff4691a4fbf71d540fd5faa..3454140ecf3abe96d3b7f112794982d70aca0322 100644 (file)
@@ -34,5 +34,7 @@ while ($f = shift @f) {                 # next field
 $to = 20 unless $to;
 $from = 0 unless $from;
 
-@out = DXLog::print($from, $to, $main::systime, 'ann', $who);
+@out = $self->spawn_cmd(\&DXLog::print, args => [$from, $to, $main::systime, 'ann', $who]);
+       
+#@out = DXLog::print($from, $to, $main::systime, 'ann', $who);
 return (1, @out);
index 7895c3b56523929d7fa54588ff309273a853574e..5ac6312e2714218e9af1f0f40e5abbd4df356467 100644 (file)
@@ -34,5 +34,7 @@ while ($f = shift @f) {                 # next field
 $to = 20 unless $to;
 $from = 0 unless $from;
 
-@out = DXLog::print($from, $to, $main::systime, 'chat', $who);
+@out = $self->spawn_cmd(\&DXLog::print, args => [$from, $to, $main::systime, 'chat', $who]);
+       
+#@out = DXLog::print($from, $to, $main::systime, 'chat', $who);
 return (1, @out);
index f2629bfff0e225ef7249e358a17b166f46d38708..b65f0f8275a54cbc6d0c9511aa90ecf3843d35ec 100644 (file)
@@ -4,12 +4,13 @@
 #
 #
 
+
 my ($self, $line) = @_;
 my @list = split /\s+/, $line; # split the line up
 
 my @out;
 my $f;
-my $call;
+my $call = $self->call;
 my ($from, $to);
 my ($fromday, $today);
 my @freq;
@@ -381,19 +382,41 @@ if ($doqra) {
 #print "expr: $expr from: $from to: $to fromday: $fromday today: $today\n";
   
 # now do the search
-my @res = Spot::search($expr, $fromday, $today, $from, $to, $hint, $dofilter ? $self : undef);
-my $ref;
-my @dx;
-foreach $ref (@res) {
-       if ($self && $self->ve7cc) {
-               push @out, VE7CC::dx_spot($self, @$ref);
-       } else {
-               if ($self && $real) {
-                       push @out, DXCommandmode::format_dx_spot($self, @$ref);
-               } else {
-                       push @out, Spot::formatl(@$ref);
-               }
-       }
-}
+
+push @out, $self->spawn_cmd(\&Spot::search, 
+                                                       args => [$expr, $fromday, $today, $from, $to, $hint, $dofilter ? $self : undef],
+                                                       cb => sub {
+                                                               my ($dxchan, @res) = @_; 
+                                                               my $ref;
+                                                               my @out;
+
+                                                               foreach $ref (@res) {
+                                                                       if ($self->ve7cc) {
+                                                                               push @out, VE7CC::dx_spot($self, @$ref);
+                                                                       } else {
+                                                                               if ($real) {
+                                                                                       push @out, DXCommandmode::format_dx_spot($self, @$ref);
+                                                                               } else {
+                                                                                       push @out, Spot::formatl(@$ref);
+                                                                               }
+                                                                       }
+                                                               }
+                                                               $dxchan->send(@out);
+                                                       });
+
+#my @res = Spot::search($expr, $fromday, $today, $from, $to, $hint, $dofilter ? $self : undef);
+#my $ref;
+#my @dx;
+#foreach $ref (@res) {
+#      if ($self && $self->ve7cc) {
+#              push @out, VE7CC::dx_spot($self, @$ref);
+#      } else {
+#              if ($self && $real) {
+#                      push @out, DXCommandmode::format_dx_spot($self, @$ref);
+#              } else {
+#                      push @out, Spot::formatl(@$ref);
+#              }
+#      }
+#}
 
 return (1, @out);
index f91e66caa9ed653faa6030c5b1458b82da52ffd5..48ab9e10d4bcb093141898673112e0f798ec9556 100644 (file)
 #
 
 use Time::Local;
-my $self = shift;
-my $to = shift;
 
-if ($to =~ /\D/) {
-    return (1, "try sh/chatgroups xxx where xxx is the number of chat messages to search.");
-}
+sub handle
+{
+       my $self = shift;
+       my $to = shift;
 
-my @out;
-my $g= {};
+       if ($to =~ /\D/) {
+               return (1, "try sh/chatgroups xxx where xxx is the number of chat messages to search.");
+       }
 
-$to = 500 unless $to;
+       my @out;
+       $to = 500 unless $to;
 
-my @chatlog = DXLog::print(undef, $to, $main::systime, 'chat', undef);
-my $row;
-my ($time, $call, $group);
-my $found;
-my %month = (
-                        Jan => 0,
-                        Feb => 1,
-                        Mar => 2,
-                        Apr => 3,
-                        May => 4,
-                        Jun => 5,
-                        Jul => 6,
-                        Aug => 7,
-                        Sep => 8,
-                        Oct => 9,
-                        Nov => 10,
-                        Dec => 11,
-                       );
+       @out = $self->spawn_cmd(\&DXLog::print, 
+                                                       args => [0, $to, $main::systime, 'chat', undef], 
+                                                       cb => sub {
+                                                               my $self = shift;
+                                                               my @chatlog = @_;
 
-@chatlog = reverse @chatlog;
-foreach $row(@chatlog) {
-    ($time, $call, $group) = ($row =~ m/^(\S+) (\S+) -> (\S+) /o);
-    if (!exists $g->{$group}) {
-               $time =~ m/^(\d\d)(\w{3})(\d{4})\@(\d\d):(\d\d):(\d\d)/o;
-               $g->{$group}->{sec} = timegm($6, $5, $4, $1, $month{$2}, $3-1900);
-               $time =~ s/\@/ at /;
-               $g->{$group}->{last} = $time;
-               push @{ $g->{$group}->{calls} }, $call;
-    } else {
-               $found = 0;
-               foreach (@{ $g->{$group}->{calls} }) {
-                       if (/$call/) {
-                               $found = 1;
-                               last;
-                       }
-               }
-               push @{ $g->{$group}->{calls} }, $call unless $found;
-    }
-    $g->{$group}->{msgcount}++;
-}
+                                                               my $g= {};
+                                                               my @out;
+                                                               my $row;
+                                                               my ($time, $call, $group);
+                                                               my $found;
+                                                               my %month = (
+                                                                                        Jan => 0,
+                                                                                        Feb => 1,
+                                                                                        Mar => 2,
+                                                                                        Apr => 3,
+                                                                                        May => 4,
+                                                                                        Jun => 5,
+                                                                                        Jul => 6,
+                                                                                        Aug => 7,
+                                                                                        Sep => 8,
+                                                                                        Oct => 9,
+                                                                                        Nov => 10,
+                                                                                        Dec => 11,
+                                                                                       );
+
+                                                               @chatlog = reverse @chatlog;
+                                                               foreach $row(@chatlog) {
+                                                                       ($time, $call, $group) = ($row =~ m/^(\S+) (\S+) -> (\S+) /o);
+                                                                       if (!exists $g->{$group}) {
+                                                                               $time =~ m/^(\d\d)(\w{3})(\d{4})\@(\d\d):(\d\d):(\d\d)/o;
+                                                                               $g->{$group}->{sec} = timegm($6, $5, $4, $1, $month{$2}, $3-1900);
+                                                                               $time =~ s/\@/ at /;
+                                                                               $g->{$group}->{last} = $time;
+                                                                               push @{ $g->{$group}->{calls} }, $call;
+                                                                       }
+                                                                       else {
+                                                                               $found = 0;
+                                                                               foreach (@{ $g->{$group}->{calls} }) {
+                                                                                       if (/$call/) {
+                                                                                               $found = 1;
+                                                                                               last;
+                                                                                       }
+                                                                               }
+                                                                               push @{ $g->{$group}->{calls} }, $call unless $found;
+                                                                       }
+                                                                       $g->{$group}->{msgcount}++;
+                                                               }
 
-push (@out, "Chat groups recently used:");
-push (@out, "($to messages searched)");
-push (@out, "--------------------------");
-my @calls;
-my @l;
-my $max = 6;
-my $mtext;
-foreach $group (sort { $g->{$b}->{sec}  <=> $g->{$a}->{sec} } keys %$g) {
-    @calls = sort( @{ $g->{$group}->{calls} } );
-    $mtext = "  " . $g->{$group}->{msgcount} . " messages by:";
-    push (@out, "$group: Last active " . $g->{$group}->{last});
-    if (@calls <= $max) {
-               push (@out, "$mtext @calls");
-    } else {
-               foreach $call(@calls) {
-                       push @l, $call;
-                       if (@l >= $max) {
-                               if ($max == 6) {
-                                       push (@out, "$mtext @l");
-                               } else {
-                                       push (@out, "  @l");
-                               }
-                               @l = ();
-                               $max = 8;
-                       }
-               }
-               push (@out, "  @l") if (@l);
-               $max = 6;
-               @l = ();
-    }
-    push (@out, "-");
+                                                               push (@out, "Chat groups recently used:");
+                                                               push (@out, "($to messages searched)");
+                                                               push (@out, "--------------------------");
+                                                               my @calls;
+                                                               my @l;
+                                                               my $max = 6;
+                                                               my $mtext;
+                                                               foreach $group (sort { $g->{$b}->{sec}  <=> $g->{$a}->{sec} } keys %$g) {
+                                                                       @calls = sort( @{ $g->{$group}->{calls} } );
+                                                                       $mtext = "  " . $g->{$group}->{msgcount} . " messages by:";
+                                                                       push (@out, "$group: Last active " . $g->{$group}->{last});
+                                                                       if (@calls <= $max) {
+                                                                               push (@out, "$mtext @calls");
+                                                                       }
+                                                                       else {
+                                                                               foreach $call(@calls) {
+                                                                                       push @l, $call;
+                                                                                       if (@l >= $max) {
+                                                                                               if ($max == 6) {
+                                                                                                       push (@out, "$mtext @l");
+                                                                                               }
+                                                                                               else {
+                                                                                                       push (@out, "  @l");
+                                                                                               }
+                                                                                               @l = ();
+                                                                                               $max = 8;
+                                                                                       }
+                                                                               }
+                                                                               push (@out, "  @l") if (@l);
+                                                                               $max = 6;
+                                                                               @l = ();
+                                                                       }
+                                                                       push (@out, "-");
+                                                               }
+                                                               $self->send(@out) if @out;
+                                                       });
+       
+       #       my @chatlog = DXLog::print(undef, $to, $main::systime, 'chat', undef);
+       return (1, @out);
 }
-return (1, @out);
index 3ff4a50b25dfab2f55027caff8ebe7aba5bec1db..5a83d4435ac723808880d118d1fe9faef72b6bb2 100644 (file)
@@ -5,38 +5,52 @@
 #
 #
 #
-my $self = shift;
 
-my $cmdline = shift;
-my @f = split /\s+/, $cmdline;
-my $f;
-my @out;
-my ($from, $to, $who, $hint); 
+sub handle
+{
+       my $self = shift;
 
-$from = 0;
-while ($f = shift @f) {                 # next field
-       #  print "f: $f list: ", join(',', @list), "\n";
-       unless ($from || $to) {
-               ($from, $to) = $f =~ /^(\d+)-(\d+)$/o;         # is it a from -> to count?
-               next if $from && $to > $from;
+       my $cmdline = shift;
+       my @f = split /\s+/, $cmdline;
+       my $f;
+       my @out;
+       my ($from, $to, $who, $hint); 
+       
+       $from = 0;
+       while ($f = shift @f) {                 # next field
+               #  print "f: $f list: ", join(',', @list), "\n";
+               unless ($from || $to) {
+                       ($from, $to) = $f =~ /^(\d+)-(\d+)$/o;         # is it a from -> to count?
+                       next if $from && $to > $from;
+               }
+               unless ($to) {
+                       ($to) = $f =~ /^(\d+)$/o if !$to;              # is it a to count?
+                       next if $to;
+               }
+               unless ($who) {
+                       $who = $f; 
+                       next if $who;
+               }
        }
-       unless ($to) {
-               ($to) = $f =~ /^(\d+)$/o if !$to;              # is it a to count?
-               next if $to;
-       }
-       unless ($who) {
-               $who = $f; 
-               next if $who;
-       }
-}
 
-$to = 20 unless $to;
-$from = 0 unless $from;
+       $to = 20 unless $to;
+       $from = 0 unless $from;
+       
+       if ($self->priv < 6) {
+               return (1, $self->msg('e5')) if defined $who && $who ne $self->call;
+               $who = $self->call;
+       }
 
-if ($self->priv < 6) {
-       return (1, $self->msg('e5')) if defined $who && $who ne $self->call;
-       $who = $self->call;
+       @out = $self->spawn_cmd(\&DXLog::print, args => [$from, $to, $main::systime, undef, $who]);
+       
+#      my $fc = Mojo::IOLoop::ForkCall->new;
+#      $fc->run(
+#                       sub {my @args = @_; my @res = DXLog::print(@args); return @res}, 
+#                       [$from, $to, $main::systime, undef, $who],
+#                       sub {my ($fc, $err, @out) = @_; delete $self->{stash}; $self->send(@out);}
+#                      );
+#      #$self->{stash} = $fc;
+       
+#      @out = DXLog::print($from, $to, $main::systime, undef, $who);
+       return (1, @out);
 }
-
-@out = DXLog::print($from, $to, $main::systime, undef, $who);
-return (1, @out);
index ef45b6c6b3aff3412e8147626995e3843760c665..57cfe0969a8ce0274af19e550784f89ddbfe5ab3 100644 (file)
@@ -33,5 +33,7 @@ while ($f = shift @f) {                 # next field
 $to = 20 unless $to;
 $from = 0 unless $from;
 
-@out = DXLog::print($from, $to, $main::systime, 'rcmd', $who);
+@out = $self->spawn_cmd(\&DXLog::print, args => [$from, $to, $main::systime, 'rcmd', $who]);
+
+#@out = DXLog::print($from, $to, $main::systime, 'rcmd', $who);
 return (1, @out);
index 869e8d3adecb8136d026b076120e4e3442d51796..3dafbc0b2bfd67201ac5d1cde4903f7b5d04b6bd 100644 (file)
@@ -35,5 +35,7 @@ if ($self->priv < 6) {
        return (1, $self->msg('e5')) if $who ne $self->call;
 }
 
-@out = DXLog::print($from, $to, $main::systime, 'talk', $who);
+@out = $self->spawn_cmd(\&DXLog::print, args => [$from, $to, $main::systime, 'talk', $who]);
+       
+#@out = DXLog::print($from, $to, $main::systime, 'talk', $who);
 return (1, @out);
index 7147b35c24ad6d1f1bab960b4be7a25d9ea583d9..cec310961b3feda189d3059536cf369a142fa0c9 100644 (file)
@@ -38,6 +38,10 @@ use VE7CC;
 use DXXml;
 use AsyncMsg;
 
+use Mojo::IOLoop;
+use Mojo::IOLoop::ForkCall;
+use Mojo::UserAgent;
+
 use strict;
 use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase %nothereslug
        $maxbadcount $msgpolltime $default_pagelth $cmdimportdir);
@@ -1241,5 +1245,57 @@ sub send_motd
        }
        $self->send_file($motd) if -e $motd;
 }
+
+# Punt off a long running command into a separate process
+#
+# Hhis is called from commands to run some potentially long running
+# function. The process forks and then runs the function and returns
+# the result back to the cmd. 
+# 
+# call: $self->spawn_cmd(\<function>, [cb => sub{...}], [prefix => "cmd> "], [progress => 0|1], [args => [...]]);
+sub spawn_cmd
+{
+       my $self = shift;
+       my $cmdref = shift;
+       my $call = $self->{call};
+       my %args = @_;
+       my @out;
+       
+       my $cb = delete $args{cb};
+       my $prefix = delete $args{prefix};
+       my $progress = delete $args{progress};
+       my $args = delete $args{args};
+
+       no strict 'refs';
+               
+       my $fc = Mojo::IOLoop::ForkCall->new;
+       $fc->run(
+                        sub {my @args = @_; my @res = $cmdref->(@args); return @res},
+                        $args,
+                        sub {
+                                my ($fc, $err, @res) = @_; 
+                                my $dxchan = DXChannel::get($call);
+                                return unless $dxchan;
+
+                                if (defined $err) {
+                                        my $s = "DXCommand::spawn_cmd: call $call error $err";
+                                        dbg($s) if isdbg('chan');
+                                        $dxchan->send($s);
+                                        return;
+                                }
+                                if ($cb) {
+                                        $cb->($dxchan, @res);
+                                } else {
+                                        return unless @res;
+                                        if (defined $prefix) {
+                                                $dxchan->send(map {"$prefix$_"} @res);
+                                        } else {
+                                                $dxchan->send(@res);
+                                        }
+                                }
+                        });
+       return @out;
+}
+
 1;
 __END__
index c2843ed579b22e580fc978bd81325b7ea144912b..b16d69e4c055b38406c7a52c30972acea6f2900f 100644 (file)
@@ -33,7 +33,7 @@ sub print
        my $to = shift || 10;
        my $jdate = $fcb->unixtoj(shift);
        my $pattern = shift;
-       my $who = uc shift;
+       my $who = shift;
        my $search;
        my @in;
        my @out = ();
@@ -41,6 +41,8 @@ sub print
        my $tot = $from + $to;
        my $hint = "";
            
+       $who = uc $who if defined $who;
+       
        if ($pattern) {
                $hint = "m{\\Q$pattern\\E}i";
        } else {
index 39c65c02d4d151a64efde0674e291725fe84236c..10dca5eb265c8bf08a030608d39fea7223f0032d 100755 (executable)
@@ -10,7 +10,7 @@
 #
 #
 
-require 5.004;
+require 5.10;
 
 # make sure that modules are searched in the order local then perl
 BEGIN {