From: Dirk Koopman Date: Tue, 17 Jun 2014 15:55:59 +0000 (+0100) Subject: mojoise sh/wm7d X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=511d83a615a5e65e85d7337c85280c2b6470a91b;p=spider.git mojoise sh/wm7d --- diff --git a/cmd/show/wm7d.pl b/cmd/show/wm7d.pl index e77bed26..5df379a3 100644 --- a/cmd/show/wm7d.pl +++ b/cmd/show/wm7d.pl @@ -17,7 +17,10 @@ sub waitfor my $buf = $conn->{msg}; $buf =~ s/\r/\\r/g; $buf =~ s/\n/\\n/g; - dbg "state $conn->{state} '$msg' '$buf'"; + + dbg "state $conn->{state} '$msg' '$buf'" if isdbg('wm7d'); + + $conn->{_wm7d} ||= []; if ($conn->{state} eq 'waitfor') { if ($msg =~ /utc$/ ) { @@ -30,13 +33,23 @@ sub waitfor $conn->{state} = 'ending'; } return if $msg =~ /^query->/; - $conn->handle_raw($msg); + push @{$conn->{_wm7d}}, $msg; } else { return if $msg =~ /^query->/ || $msg =~ /bye/; - $conn->handle_raw($msg); +# $conn->handle_raw($msg); + push @{$conn->{_wm7d}}, $msg; } } +sub on_disc +{ + my $conn = shift; + my $dxchan = shift; + $DB::single = 1; + + $dxchan->send(map {"$conn->{prefix}$_"} @{$conn->{_wm7d}}); +} + # wm7d accepts only single callsign sub handle { @@ -58,7 +71,7 @@ sub handle Log('call', "$call: show/wm7d \U$line"); my $conn = AsyncMsg->raw($self, $target, $port, - handler => \&waitfor, prefix=>'wm7d> '); + handler => \&waitfor, prefix=>'wm7d> ', on_disc =>\&on_disc); if ($conn) { $conn->{state} = 'waitfor'; $conn->{target_call} = $line; diff --git a/perl/AsyncMsg.pm b/perl/AsyncMsg.pm index 95c5e8f6..ff3b3bca 100644 --- a/perl/AsyncMsg.pm +++ b/perl/AsyncMsg.pm @@ -203,9 +203,11 @@ sub raw my %args = @_; my $handler = delete $args{handler} || \&handle_raw; + my $conn = $pkg->new($call, $handler); $conn->{prefix} = delete $args{prefix} if exists $args{prefix}; $conn->{prefix} ||= ''; + $conn->{on_disconnect} = delete $args{on_disc} || delete $args{on_disconnect}; $r = $conn->connect($host, $port, on_connect => &_on_raw_connect); return $r ? $conn : undef; } diff --git a/perl/Msg.pm b/perl/Msg.pm index 1c86c70d..cd5dd051 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -266,7 +266,7 @@ sub disconnect } if (defined($sock)) { - $sock->close_gracefully; + $sock->close; } unless ($main::is_win) {