From: Dirk Koopman <djk@tobit.co.uk>
Date: Tue, 17 Jun 2014 19:43:02 +0000 (+0100)
Subject: add DXCommand::spawn_cmd and convert suitable cmds
X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=0ce79a125db0acb043fceaa641d8b3a9eae71a41;p=spider.git

add DXCommand::spawn_cmd and convert suitable cmds

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)
---

diff --git a/cmd/Aliases b/cmd/Aliases
index 84b4c182..f391a850 100644
--- a/cmd/Aliases
+++ b/cmd/Aliases
@@ -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',
diff --git a/cmd/show/announce.pl b/cmd/show/announce.pl
index 9ec0111b..3454140e 100644
--- a/cmd/show/announce.pl
+++ b/cmd/show/announce.pl
@@ -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);
diff --git a/cmd/show/chat.pl b/cmd/show/chat.pl
index 7895c3b5..5ac6312e 100644
--- a/cmd/show/chat.pl
+++ b/cmd/show/chat.pl
@@ -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);
diff --git a/cmd/show/dx.pl b/cmd/show/dx.pl
index f2629bff..b65f0f82 100644
--- a/cmd/show/dx.pl
+++ b/cmd/show/dx.pl
@@ -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);
diff --git a/cmd/show/groups.pl b/cmd/show/groups.pl
index f91e66ca..48ab9e10 100644
--- a/cmd/show/groups.pl
+++ b/cmd/show/groups.pl
@@ -7,89 +7,105 @@
 #
 
 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);
diff --git a/cmd/show/log.pl b/cmd/show/log.pl
index 3ff4a50b..5a83d443 100644
--- a/cmd/show/log.pl
+++ b/cmd/show/log.pl
@@ -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);
diff --git a/cmd/show/rcmd.pl b/cmd/show/rcmd.pl
index ef45b6c6..57cfe096 100644
--- a/cmd/show/rcmd.pl
+++ b/cmd/show/rcmd.pl
@@ -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);
diff --git a/cmd/show/talk.pl b/cmd/show/talk.pl
index 869e8d3a..3dafbc0b 100644
--- a/cmd/show/talk.pl
+++ b/cmd/show/talk.pl
@@ -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);
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 7147b35c..cec31096 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -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__
diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm
index c2843ed5..b16d69e4 100644
--- a/perl/DXLogPrint.pm
+++ b/perl/DXLogPrint.pm
@@ -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 {
diff --git a/perl/cluster.pl b/perl/cluster.pl
index 39c65c02..10dca5eb 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -10,7 +10,7 @@
 #
 #
 
-require 5.004;
+require 5.10;
 
 # make sure that modules are searched in the order local then perl
 BEGIN {