X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FExtMsg.pm;h=78daffe263483b32d53a405c154ee696adadac47;hb=f5028d38602385a6614c6234fa4165ee4f9e159c;hp=7b33b6e2780d43e19d663d63f0fe4bdf59a0b14f;hpb=6624dcdf07d628e8d6a16fc6549edf40be25b7b2;p=spider.git diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index 7b33b6e2..78daffe2 100644 --- a/perl/ExtMsg.pm +++ b/perl/ExtMsg.pm @@ -21,6 +21,12 @@ use IO::File; use IO::Socket; use IPC::Open3; +use vars qw($VERSION $BRANCH); +$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0; +$main::build += $VERSION; +$main::branch += $BRANCH; + use vars qw(@ISA $deftimeout); @ISA = qw(Msg); @@ -54,6 +60,12 @@ sub send_raw Msg::set_event_handler ($sock, "write" => sub {$conn->_send(0)}); } +sub echo +{ + my $conn = shift; + $conn->{echo} = shift; +} + sub dequeue { my $conn = shift; @@ -77,7 +89,7 @@ sub dequeue if ($conn->{msg} =~ /\cJ$/) { delete $conn->{msg}; } else { - $conn->{msg} = pop @lines; + $conn->{msg} =~ s/([^\cM\cJ]*)\cM?\cJ//g; } while (defined ($msg = shift @lines)) { dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect'); @@ -89,7 +101,7 @@ sub dequeue &{$conn->{rproc}}($conn, "I$conn->{call}|$msg"); } elsif ($conn->{state} eq 'WL' ) { $msg = uc $msg; - if (is_callsign($msg)) { + if (is_callsign($msg) && $msg !~ m|/| ) { my $sort = $conn->{csort}; $sort = 'local' if $conn->{peerhost} eq "127.0.0.1"; $conn->to_connected($msg, 'A', $sort); @@ -154,6 +166,7 @@ sub new_client { $conn->_send_file("$main::data/issue"); $conn->send_raw("login: "); $conn->_dotimeout(60); + $conn->{echo} = 1; } else { &{$conn->{eproc}}() if $conn->{eproc}; $conn->disconnect(); @@ -200,8 +213,8 @@ sub _docmd last; } } - if ($cmd =~ /^\s*\'.*\'\s+\'.*\'/i) { - $conn->_dochat($cmd, $msg); + if ($cmd =~ /^\s*\'([^\']*)\'\s+\'([^\']*)\'/) { + $conn->_dochat($cmd, $msg, $1, $2); last; } if ($cmd =~ /^\s*cl\w+\s+(.*)/i) { @@ -317,9 +330,10 @@ sub _dochat my $conn = shift; my $cmd = shift; my $line = shift; + my $expect = shift; + my $send = shift; if ($line) { - my ($expect, $send) = $cmd =~ /^\s*\'(.*)\'\s+\'(.*)\'/; if ($expect) { dbg("connect $conn->{cnum}: expecting: \"$expect\" received: \"$line\"") if isdbg('connect'); if ($conn->{abort} && $line =~ /\Q$conn->{abort}/i) {