'^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',
$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);
$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);
#
#
+
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;
#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);
#
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);
#
#
#
-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);
$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);
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);
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);
}
$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__
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 = ();
my $tot = $from + $to;
my $hint = "";
+ $who = uc $who if defined $who;
+
if ($pattern) {
$hint = "m{\\Q$pattern\\E}i";
} else {
#
#
-require 5.004;
+require 5.10;
# make sure that modules are searched in the order local then perl
BEGIN {
projects / spider.git / commitdiff