use latest big cty.dat
[spider.git] / perl / Msg.pm
index dcc3c812d1ac77763c3e41bd47439a17a4589885..fc1179c5828aec64d280f0ec94ca84e91a77b2cd 100644 (file)
@@ -61,11 +61,12 @@ sub set_error
        $conn->{eproc} = $callback;
 }
 
-sub set_eof
+sub set_on_eof
 {
        my $conn = shift;
        my $callback = shift;
-       $conn->{sock}->on_eof(sub {$callback});
+       $conn->{sock}->on_eof($callback);
+       $conn->{sock}->on_error($callback);
 }
 
 sub set_rproc
@@ -141,7 +142,7 @@ sub connect {
 
                connect => [$to_host, $to_port],
 
-#              on_connect => sub {my $h = shift; $conn->{peerhost} = $h->handle->peername;},
+               on_connect => sub {my $h = shift; $conn->{peerhost} = shift;},
 
                on_eof => sub {$conn->disconnect},
 
@@ -233,9 +234,14 @@ sub disconnect
                }
        }
 
-       if (defined($sock)) {
+       if (ref $sock && $sock->isa('AnyEvent::Handle') && exists $sock->{fh}) {
                shutdown($sock->{fh}, 2);
                $sock->destroy;
+       } else {
+               my $s;
+               $s = "already destroyed" unless exists $sock->{fh};
+               $s ||= ref $sock || $sock || "undefined";
+               dbg("Msg::disconnect trying to disconnect a $s socket") if isdbg('chan');
        }
        
        unless ($main::is_win) {
@@ -310,7 +316,7 @@ sub new_server {
     my ($pkg, $my_host, $my_port, $login_proc) = @_;
        my $self = $pkg->new($login_proc);
        
-    $self->{sock} = tcp_server $my_host, $my_port, sub { $self->new_client(@_); }, sub { return 256; };
+    $self->{sock} = tcp_server $my_host, $my_port, sub { $self->new_client(@_); };
     die "Could not create socket: $! \n" unless $self->{sock};
        return $self;
 }
@@ -407,12 +413,12 @@ sub new_client {
                my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost} = $peerhost, $conn->{peerport} = $peerport);
                dbg("accept $conn->{cnum} from $conn->{peerhost} $conn->{peerport}") if isdbg('connll');
                $conn->{sort} = 'Incoming';
+               $conn->{sock}->on_read(sub {$conn->_rcv});
                if ($eproc) {
                        $conn->{eproc} = $eproc;
                }
                if ($rproc) {
                        $conn->{rproc} = $rproc;
-                       $conn->{sock}->on_read(sub {$conn->_rcv});
                } else {  # Login failed
                        &{$conn->{eproc}}($conn, undef) if exists $conn->{eproc};
                        $conn->disconnect();
@@ -466,6 +472,12 @@ sub set_event_handler
        dbg("Msg::set_event_handler called from ${pkg}::${fn} line $line doing $s");
 }
 
+sub echo
+{
+       my $conn = shift;
+       return defined $_[0] ? $conn->{echo} = $_[0] : $_[0];
+}
+
 sub DESTROY
 {
        my $conn = shift;