From a76624e4742348ed0f39c7c3f732cdec8462da9e Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Tue, 17 Jun 2014 22:50:30 +0100 Subject: [PATCH] make several show/* cmds non-blocking --- Changes | 2 + cmd/show/hfstats.pl | 80 ++++++++++++++++-------------- cmd/show/hftable.pl | 110 ++++++++++++++++++++++------------------- cmd/show/isolate.pl | 47 +++++++++++++----- cmd/show/lockout.pl | 32 +++++++++--- cmd/show/registered.pl | 34 ++++++++++--- cmd/show/vhfstats.pl | 70 ++++++++++++++------------ cmd/show/vhftable.pl | 109 +++++++++++++++++++++------------------- perl/DXCommandmode.pm | 2 +- perl/Version.pm | 4 +- 10 files changed, 290 insertions(+), 200 deletions(-) diff --git a/Changes b/Changes index d6ecb295..35e6c9da 100644 --- a/Changes +++ b/Changes @@ -4,6 +4,8 @@ non-blocking. This should allow incoming and outgoing protocol to continue flowing when such a command is run. 3. Added some usable code to show/wx (finally). +4. Make stats cmds (sh/v?hfstats, sh/v?hftable) non-blocking. +5. Make sh/isolate, sh/registered, sh/lockout non-blocking. 16Jun14======================================================================= 1. Get AsyncMsg working for HTTP type ephemeral connections 21Apr14======================================================================= diff --git a/cmd/show/hfstats.pl b/cmd/show/hfstats.pl index fdbd8efd..c2e055f7 100644 --- a/cmd/show/hfstats.pl +++ b/cmd/show/hfstats.pl @@ -28,8 +28,6 @@ use Date::Parse; my ($self, $line) = @_; my @f = split /\s+/, $line; my $days = 31; -my $i; -my @in; my $now; my $date = cldate($main::systime); my $utime = $main::systime; @@ -55,40 +53,48 @@ $now = Julian::Day->new($utime); $now = $now->sub($days); $date = cldate($utime); -# generate the spot list -for ($i = 0; $i < $days; $i++) { - my $fh = $Spot::statp->open($now); # get the next file - unless ($fh) { - Spot::genstats($now); - $fh = $Spot::statp->open($now); - } - while (<$fh>) { - chomp; - my @l = split /\^/; - next unless $l[0] eq 'TOTALS'; - next unless $l[1]; - $l[0] = $now; - push @in, \@l; - last; - } - $now = $now->add(1); -} - -my @tot; - -push @out, $self->msg('stathf', $date, $days); -push @out, sprintf "%6s|%6s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|", qw(Date Total 160m 80m 60m 40m 30m 20m 17m 15m 12m 10m); -foreach my $ref (@in) { - my $linetot = 0; - foreach my $j (4..13) { - $tot[$j] += $ref->[$j]; - $tot[0] += $ref->[$j]; - $linetot += $ref->[$j]; - } - my $date = $ref->[0]->as_string; - $date =~ s/-\d+$//; - push @out, join '|', sprintf("%6s|%6d", $date, $linetot), map {$_ ? sprintf("%5d", $_) : ' '} @$ref[4..13], ""; -} -push @out, join '|', sprintf("%6s|%6d", 'Total', $tot[0]), map {$_ ? sprintf("%5d", $_) : ' '} @tot[4..13], ""; +@out = $self->spawn_cmd(sub { + my %list; + my @out; + my @in; + my $i; + # generate the spot list + for ($i = 0; $i < $days; $i++) { + my $fh = $Spot::statp->open($now); # get the next file + unless ($fh) { + Spot::genstats($now); + $fh = $Spot::statp->open($now); + } + while (<$fh>) { + chomp; + my @l = split /\^/; + next unless $l[0] eq 'TOTALS'; + next unless $l[1]; + $l[0] = $now; + push @in, \@l; + last; + } + $now = $now->add(1); + } + + my @tot; + + push @out, $self->msg('stathf', $date, $days); + push @out, sprintf "%6s|%6s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|", qw(Date Total 160m 80m 60m 40m 30m 20m 17m 15m 12m 10m); + foreach my $ref (@in) { + my $linetot = 0; + foreach my $j (4..13) { + $tot[$j] += $ref->[$j]; + $tot[0] += $ref->[$j]; + $linetot += $ref->[$j]; + } + my $date = $ref->[0]->as_string; + $date =~ s/-\d+$//; + push @out, join '|', sprintf("%6s|%6d", $date, $linetot), map {$_ ? sprintf("%5d", $_) : ' '} @$ref[4..13], ""; + } + push @out, join '|', sprintf("%6s|%6d", 'Total', $tot[0]), map {$_ ? sprintf("%5d", $_) : ' '} @tot[4..13], ""; + return @out + }); + return (1, @out); diff --git a/cmd/show/hftable.pl b/cmd/show/hftable.pl index 40e54aa9..25cb9c0b 100644 --- a/cmd/show/hftable.pl +++ b/cmd/show/hftable.pl @@ -40,8 +40,6 @@ my @calls; my $days = 31; my @dxcc; my $limit = 100; -my %list; -my $i; my $now; my @pref; my @out; @@ -97,57 +95,65 @@ unless ($now) { $date = cldate(time); } -# generate the spot list -for ($i = 0; $i < $days; $i++) { - my $fh = $Spot::statp->open($now); # get the next file - unless ($fh) { - Spot::genstats($now); - $fh = $Spot::statp->open($now); - } - while (<$fh>) { - chomp; - my @l = split /\^/; - next if $l[0] eq 'TOTALS'; - next unless $all || grep $l[$_->[1]] eq $_->[0], @dxcc; - my $ref = $list{$l[0]} || [0,0,0,0,0,0,0,0,0,0]; - my $j = 1; - foreach my $item (@l[4..13]) { - $ref->[$j] += $item; - $ref->[0] += $item; - $j++; - } - $list{$l[0]} = $ref if $ref->[0]; - } - $now = $now->sub(1); -} - -my @tot; -my $nocalls; +@out = $self->spawn_cmd(sub { + my %list; + my @out; + my $i; + + # generate the spot list + for ($i = 0; $i < $days; $i++) { + my $fh = $Spot::statp->open($now); # get the next file + unless ($fh) { + Spot::genstats($now); + $fh = $Spot::statp->open($now); + } + while (<$fh>) { + chomp; + my @l = split /\^/; + next if $l[0] eq 'TOTALS'; + next unless $all || grep $l[$_->[1]] eq $_->[0], @dxcc; + my $ref = $list{$l[0]} || [0,0,0,0,0,0,0,0,0,0]; + my $j = 1; + foreach my $item (@l[4..13]) { + $ref->[$j] += $item; + $ref->[0] += $item; + $j++; + } + $list{$l[0]} = $ref if $ref->[0]; + } + $now = $now->sub(1); + } + + my @tot; + my $nocalls; + + my $l = join ',', @pref; + push @out, $self->msg('stathft', $l, $date, $days); + push @out, sprintf "%9s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|", qw(Callsign Tot 160m 80m 60m 40m 30m 20m 17m 15m 12m 10m); + + for (sort {$list{$b}->[0] <=> $list{$a}->[0] || $a cmp $b} keys %list) { + my $ref = $list{$_}; + $nocalls++; + my @list = (sprintf "%9s", $_); + foreach my $j (0..11) { + my $r = $ref->[$j]; + if ($r) { + $tot[$j] += $r; + $r = sprintf("%5d", $r); + } else { + $r = ' '; + } + push @list, $r; + } + push @out, join('|', @list); + last if $limit && $nocalls >= $limit; + } -my $l = join ',', @pref; -push @out, $self->msg('stathft', $l, $date, $days); -push @out, sprintf "%9s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|", qw(Callsign Tot 160m 80m 60m 40m 30m 20m 17m 15m 12m 10m); - -for (sort {$list{$b}->[0] <=> $list{$a}->[0] || $a cmp $b} keys %list) { - my $ref = $list{$_}; - $nocalls++; - my @list = (sprintf "%9s", $_); - foreach my $j (0..11) { - my $r = $ref->[$j]; - if ($r) { - $tot[$j] += $r; - $r = sprintf("%5d", $r); - } else { - $r = ' '; - } - push @list, $r; - } - push @out, join('|', @list); - last if $limit && $nocalls >= $limit; -} + $nocalls = sprintf "%9s", "$nocalls calls"; + @tot = map {$_ ? sprintf("%5d", $_) : ' ' } @tot; + push @out, join('|', $nocalls, @tot,""); + return @out; + }); -$nocalls = sprintf "%9s", "$nocalls calls"; -@tot = map {$_ ? sprintf("%5d", $_) : ' ' } @tot; -push @out, join('|', $nocalls, @tot,""); return (1, @out); diff --git a/cmd/show/isolate.pl b/cmd/show/isolate.pl index daa77f42..979bf0d3 100644 --- a/cmd/show/isolate.pl +++ b/cmd/show/isolate.pl @@ -15,17 +15,40 @@ my @out; use DB_File; -my ($action, $count, $key, $data) = (0,0,0,0); -for ($action = DXUser::R_FIRST, $count=0; !$DXUser::dbm->seq($key, $data, $action); $action = DXUser::R_NEXT) { - if ($data =~ m{isolate}) { - my $u = DXUser::get_current($key); - if ($u && $u->isolate) { - push @out, $key; - ++$count; - } - } -} - -return (1, @out, $self->msg('rec', $count)); +@out = $self->spawn_cmd(sub { + my @out; + my @val; + + my ($action, $count, $key, $data) = (0,0,0,0); + + for ($action = DXUser::R_FIRST, $count=0; !$DXUser::dbm->seq($key, $data, $action); $action = DXUser::R_NEXT) { + if ($data =~ m{isolate}) { + my $u = DXUser::get_current($key); + if ($u && $u->isolate) { + push @val, $key; + ++$count; + } + } + } + + my @l; + foreach my $call (@val) { + if (@l >= 5) { + push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l; + @l = (); + } + push @l, $call; + } + if (@l) { + push @l, "" while @l < 5; + push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l; + } + + push @out, , $self->msg('rec', $count); + return @out; + }); + + +return (1, @out); diff --git a/cmd/show/lockout.pl b/cmd/show/lockout.pl index 91ae4f4a..d2133df5 100644 --- a/cmd/show/lockout.pl +++ b/cmd/show/lockout.pl @@ -22,21 +22,41 @@ if ($line) { return (1, $self->msg('lockoutuse')) unless $line; -my ($action, $count, $key, $data) = (0,0,0,0); -eval qq{for (\$action = DXUser::R_FIRST, \$count = 0; !\$DXUser::dbm->seq(\$key, \$data, \$action); \$action = DXUser::R_NEXT) { +@out = $self->spawn_cmd(sub { + my @out; + my @val; + my ($action, $count, $key, $data) = (0,0,0,0); + eval qq{for (\$action = DXUser::R_FIRST, \$count = 0; !\$DXUser::dbm->seq(\$key, \$data, \$action); \$action = DXUser::R_NEXT) { if (\$data =~ m{lockout}) { if (\$line eq 'ALL' || \$key =~ /^$line/) { my \$ur = DXUser::get_current(\$key); if (\$ur && \$ur->lockout) { - push \@out, \$key; + push \@val, \$key; ++\$count; } } } } }; -push @out, $@ if $@; - -return (1, @out, $self->msg('rec', $count)); + my @l; + foreach my $call (@val) { + if (@l >= 5) { + push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l; + @l = (); + } + push @l, $call; + } + if (@l) { + push @l, "" while @l < 5; + push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l; + } + + push @out, $@ if $@; + push @out, $self->msg('rec', $count); + return @out; + }); + + +return (1, @out); diff --git a/cmd/show/registered.pl b/cmd/show/registered.pl index 5eb6d78d..7e3ce45d 100644 --- a/cmd/show/registered.pl +++ b/cmd/show/registered.pl @@ -20,21 +20,41 @@ if ($line) { $line = "^\U\Q$line"; } -my ($action, $count, $key, $data) = (0,0,0,0); -eval qq{for (\$action = DXUser::R_FIRST, \$count = 0; !\$DXUser::dbm->seq(\$key, \$data, \$action); \$action = DXUser::R_NEXT) { +@out = $self->spawn_cmd(sub { + my @out; + my @val; + + + my ($action, $count, $key, $data) = (0,0,0,0); + eval qq{for (\$action = DXUser::R_FIRST, \$count = 0; !\$DXUser::dbm->seq(\$key, \$data, \$action); \$action = DXUser::R_NEXT) { if (\$data =~ m{registered}) { if (!\$line || (\$line && \$key =~ /^$line/)) { my \$u = DXUser::get_current(\$key); if (\$u && \$u->registered) { - push \@out, \$key; + push \@val, \$key; ++\$count; } } } } }; - -push @out, $@ if $@; - -return (1, @out, $self->msg('rec', $count)); + my @l; + foreach my $call (@val) { + if (@l >= 5) { + push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l; + @l = (); + } + push @l, $call; + } + if (@l) { + push @l, "" while @l < 5; + push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l; + } + + push @out, $@ if $@; + push @out, , $self->msg('rec', $count); + return @out; + }); + +return (1, @out); diff --git a/cmd/show/vhfstats.pl b/cmd/show/vhfstats.pl index 26970f6a..402cc06d 100644 --- a/cmd/show/vhfstats.pl +++ b/cmd/show/vhfstats.pl @@ -9,8 +9,6 @@ my ($self, $line) = @_; my @f = split /\s+/, $line; my $days = 31; -my $i; -my @in; my $now; my $date = cldate($main::systime); my $utime = $main::systime; @@ -36,38 +34,46 @@ $now = Julian::Day->new($utime); $now = $now->sub($days); $date = cldate($utime); +@out = $self->spawn_cmd(sub { + my %list; + my @out; + my @in; + my $i; + # generate the spot list -for ($i = 0; $i < $days; $i++) { - my $fh = $Spot::statp->open($now); # get the next file - unless ($fh) { - Spot::genstats($now); - $fh = $Spot::statp->open($now); - } - while (<$fh>) { - chomp; - my @l = split /\^/; - next unless $l[0] eq 'TOTALS'; - next unless $l[1]; - $l[0] = $now; - push @in, \@l; - last; - } - $now = $now->add(1); -} + for ($i = 0; $i < $days; $i++) { + my $fh = $Spot::statp->open($now); # get the next file + unless ($fh) { + Spot::genstats($now); + $fh = $Spot::statp->open($now); + } + while (<$fh>) { + chomp; + my @l = split /\^/; + next unless $l[0] eq 'TOTALS'; + next unless $l[1]; + $l[0] = $now; + push @in, \@l; + last; + } + $now = $now->add(1); + } -my @tot; + my @tot; -push @out, $self->msg('statvhf', $date, $days); -push @out, sprintf "%11s|%6s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|", qw(Date Total 6m 4m 2m 70cm 23cm 13cm 9cm 6cm 3cm); -foreach my $ref (@in) { - my $linetot = 0; - foreach my $j (14..16,18..23) { - $tot[$j] += $ref->[$j]; - $tot[0] += $ref->[$j]; - $linetot += $ref->[$j]; - } - push @out, join('|', sprintf("%11s|%6d", $ref->[0]->as_string, $linetot), map {$_ ? sprintf("%5d", $_) : ' '} @$ref[14..16,18..23]) . '|'; -} -push @out, join('|', sprintf("%11s|%6d", 'Total', $tot[0]), map {$_ ? sprintf("%5d", $_) : ' '} @tot[14..16,18..23]) . '|'; + push @out, $self->msg('statvhf', $date, $days); + push @out, sprintf "%11s|%6s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|%5s|", qw(Date Total 6m 4m 2m 70cm 23cm 13cm 9cm 6cm 3cm); + foreach my $ref (@in) { + my $linetot = 0; + foreach my $j (14..16,18..23) { + $tot[$j] += $ref->[$j]; + $tot[0] += $ref->[$j]; + $linetot += $ref->[$j]; + } + push @out, join('|', sprintf("%11s|%6d", $ref->[0]->as_string, $linetot), map {$_ ? sprintf("%5d", $_) : ' '} @$ref[14..16,18..23]) . '|'; + } + push @out, join('|', sprintf("%11s|%6d", 'Total', $tot[0]), map {$_ ? sprintf("%5d", $_) : ' '} @tot[14..16,18..23]) . '|'; + return @out; + }); return (1, @out); diff --git a/cmd/show/vhftable.pl b/cmd/show/vhftable.pl index d1320290..a4a78491 100644 --- a/cmd/show/vhftable.pl +++ b/cmd/show/vhftable.pl @@ -12,8 +12,6 @@ my @calls; my $days = 31; my @dxcc; my $limit = 100; -my %list; -my $i; my $now; my @pref; my @out; @@ -69,58 +67,67 @@ unless ($now) { $date = cldate(time); } -# generate the spot list -for ($i = 0; $i < $days; $i++) { - my $fh = $Spot::statp->open($now); # get the next file - unless ($fh) { - Spot::genstats($now); - $fh = $Spot::statp->open($now); - } - while (<$fh>) { - chomp; - my @l = split /\^/; - next if $l[0] eq 'TOTALS'; - next unless $all || grep $l[$_->[1]] eq $_->[0], @dxcc; - my $ref = $list{$l[0]} || [0,0,0,0,0,0,0,0,0,0]; - my $j = 1; - foreach my $item (@l[14..16, 18..23]) { - $ref->[$j] += $item; - $ref->[0] += $item; - $j++; - } - $list{$l[0]} = $ref if $ref->[0]; - } - $now = $now->sub(1); -} +@out = $self->spawn_cmd(sub { + my %list; + my @out; + my $i; + + # generate the spot list + for ($i = 0; $i < $days; $i++) { + my $fh = $Spot::statp->open($now); # get the next file + unless ($fh) { + Spot::genstats($now); + $fh = $Spot::statp->open($now); + } + while (<$fh>) { + chomp; + my @l = split /\^/; + next if $l[0] eq 'TOTALS'; + next unless $all || grep $l[$_->[1]] eq $_->[0], @dxcc; + my $ref = $list{$l[0]} || [0,0,0,0,0,0,0,0,0,0]; + my $j = 1; + foreach my $item (@l[14..16, 18..23]) { + $ref->[$j] += $item; + $ref->[0] += $item; + $j++; + } + $list{$l[0]} = $ref if $ref->[0]; + } + $now = $now->sub(1); + } -my @tot; -my $nocalls; + my @tot; + my $nocalls; -my $l = join ',', @pref; -push @out, $self->msg('statvhft', $l, $date, $days); -#push @out, $self->msg('statvhft', join(',', @dxcc), cldate(time)); -push @out, sprintf "%10s|%4s|%4s|%4s|%4s|%4s|%4s|%4s|%4s|%4s|%4s|", qw(Callsign Tot 6m 4m 2m 70cm 23cm 13cm 9cm 6cm 3cm); + my $l = join ',', @pref; + push @out, $self->msg('statvhft', $l, $date, $days); + #push @out, $self->msg('statvhft', join(',', @dxcc), cldate(time)); + push @out, sprintf "%10s|%4s|%4s|%4s|%4s|%4s|%4s|%4s|%4s|%4s|%4s|", qw(Callsign Tot 6m 4m 2m 70cm 23cm 13cm 9cm 6cm 3cm); -for (sort {$list{$b}->[0] <=> $list{$a}->[0] || $a cmp $b} keys %list) { - my $ref = $list{$_}; - $nocalls++; - my @list = (sprintf "%10s", $_); - foreach my $j (0..9) { - my $r = $ref->[$j]; - if ($r) { - $tot[$j] += $r; - $r = sprintf("%4d", $r); - } else { - $r = ' '; - } - push @list, $r; - } - push @out, join('|', @list, ""); - last if $limit && $nocalls >= $limit; -} + for (sort {$list{$b}->[0] <=> $list{$a}->[0] || $a cmp $b} keys %list) { + my $ref = $list{$_}; + $nocalls++; + my @list = (sprintf "%10s", $_); + foreach my $j (0..9) { + my $r = $ref->[$j]; + if ($r) { + $tot[$j] += $r; + $r = sprintf("%4d", $r); + } + else { + $r = ' '; + } + push @list, $r; + } + push @out, join('|', @list, ""); + last if $limit && $nocalls >= $limit; + } + + $nocalls = sprintf "%10s", "$nocalls calls"; + @tot = map {$_ ? sprintf("%4d", $_) : ' ' } @tot; + push @out, join('|', $nocalls, @tot, ""); -$nocalls = sprintf "%10s", "$nocalls calls"; -@tot = map {$_ ? sprintf("%4d", $_) : ' ' } @tot; -push @out, join('|', $nocalls, @tot, ""); + return @out; + }); return (1, @out); diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index cec31096..1e3efc47 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -1264,7 +1264,7 @@ sub spawn_cmd my $cb = delete $args{cb}; my $prefix = delete $args{prefix}; my $progress = delete $args{progress}; - my $args = delete $args{args}; + my $args = delete $args{args} || []; no strict 'refs'; diff --git a/perl/Version.pm b/perl/Version.pm index bda3e650..22163789 100644 --- a/perl/Version.pm +++ b/perl/Version.pm @@ -10,7 +10,7 @@ package main; use vars qw($version $build $gitversion); $version = '1.57'; -$build = '26'; -$gitversion = '96b4514'; +$build = '29'; +$gitversion = '761aaa7'; 1; -- 2.43.0