mojoise sh/wm7d

diff --git a/cmd/show/wm7d.pl b/cmd/show/wm7d.pl
index e77bed269dfcd7783f3cccd27634752e2fd06074..5df379a3e7676db9e0f426ab27d304be9dcd232c 100644 (file)
--- 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 95c5e8f67c974d8eace5f0e5ba9b7fbf69ef42f1..ff3b3bca07c01eae0c52afbc43a6cebfe08830c8 100644 (file)
--- 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 1c86c70ddd170a3a55b093dafd82087b0a2f5dd0..cd5dd051b8c384f0011fdd496335c2638d9f9570 100644 (file)
--- 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) {