Got something basically working

Need to sort out shutdown and related things

diff --git a/cmd/bye.pl b/cmd/bye.pl
index 41d3ee91af35a549d17dcfd57019b4c72ae82b75..4d8a8754d23f04e3de0516148893339645cf546d 100644 (file)
--- a/cmd/bye.pl
+++ b/cmd/bye.pl
@@ -13,7 +13,7 @@ if ($self->is_user && -e "$main::data/logout") {
        my @in = <I>;
        close(I);
        $self->send_now('D', @in);
        my @in = <I>;
        close(I);
        $self->send_now('D', @in);

-       sleep(1);
+       Msg->sleep(1);

 }
 
 #$self->send_now('Z', "");
 }
 
 #$self->send_now('Z', "");

diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 958fe61860b3cb69122df0101fe8741c6afcc805..8fc86495cc759da969a7ada953963654d016f8e9 100644 (file)
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -386,9 +386,9 @@ sub send_now
 #              chomp;
         my @lines = split /\n/;
                for (@lines) {
 #              chomp;
         my @lines = split /\n/;
                for (@lines) {

+                       dbg("-> $sort $call $_") if $sort ne 'L' && isdbg('chan');

                        $conn->send_now("$sort$call|$_");
                        # debug log it, but not if it is a log message
                        $conn->send_now("$sort$call|$_");
                        # debug log it, but not if it is a log message

-                       dbg("-> $sort $call $_") if $sort ne 'L' && isdbg('chan');

                }
        }
        $self->{t} = time;
                }
        }
        $self->{t} = time;


@@ -410,9 +410,9 @@ sub send_later
 #              chomp;
         my @lines = split /\n/;
                for (@lines) {
 #              chomp;
         my @lines = split /\n/;
                for (@lines) {

+                       dbg("-> $sort $call $_") if $sort ne 'L' && isdbg('chan');

                        $conn->send_later("$sort$call|$_");
                        # debug log it, but not if it is a log message
                        $conn->send_later("$sort$call|$_");
                        # debug log it, but not if it is a log message

-                       dbg("-> $sort $call $_") if $sort ne 'L' && isdbg('chan');

                }
        }
        $self->{t} = time;
                }
        }
        $self->{t} = time;


@@ -432,8 +432,8 @@ sub send                                            # this is always later and always data
                for (ref $l ? @$l : $l) {
                        my @lines = split /\n/;
                        for (@lines) {
                for (ref $l ? @$l : $l) {
                        my @lines = split /\n/;
                        for (@lines) {

-                               $conn->send_later("D$call|$_");

                                dbg("-> D $call $_") if isdbg('chan');
                                dbg("-> D $call $_") if isdbg('chan');

+                               $conn->send_later("D$call|$_");

                        }
                }
        }
                        }
                }
        }


@@ -500,7 +500,7 @@ sub disconnect
        my $user = $self->{user};
        
        $user->close() if defined $user;
        my $user = $self->{user};
        
        $user->close() if defined $user;

-       $self->{conn}->disconnect if $self->{conn};
+       $self->{conn}->close_on_empty if $self->{conn};

        $self->del();
 }
 
        $self->del();
 }
 

diff --git a/perl/Msg.pm b/perl/Msg.pm
index ea2747dc1f158de86ca15512eb8506814495ea0e..4bc31faddfcf92546427549c4a0f81d5e39f45c8 100644 (file)
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -123,7 +123,9 @@ sub connect {
 
     # Create a connection end-point object
     my $conn = $pkg;
 
     # Create a connection end-point object
     my $conn = $pkg;

-       $conn = $pkg->new($rproc);
+       unless (ref $pkg) {
+               $conn = $pkg->new($rproc);
+       }

        $conn->{peerhost} = $to_host;
        $conn->{peerport} = $to_port;
        $conn->{sort} = 'Outgoing';
        $conn->{peerhost} = $to_host;
        $conn->{peerport} = $to_port;
        $conn->{sort} = 'Outgoing';


@@ -225,6 +227,7 @@ sub disconnect
        }
 
        if (defined($sock)) {
        }
 
        if (defined($sock)) {

+               shutdown($sock->{fh}, 2);

                $sock->destroy;
        }
        
                $sock->destroy;
        }
        


@@ -242,14 +245,18 @@ sub _send_stuff
        while (@$rq) {
                my $data = shift @$rq;
                my $lth = length $data;
        while (@$rq) {
                my $data = shift @$rq;
                my $lth = length $data;

+               my $call = $conn->{call} || 'none';

                if (isdbg('raw')) {
                if (isdbg('raw')) {

-                       my $call = $conn->{call} || 'none';

                        if (isdbg('raw')) {
                                dbgdump('raw', "$call send $lth: ", $lth);
                        }
                }
                        if (isdbg('raw')) {
                                dbgdump('raw', "$call send $lth: ", $lth);
                        }
                }

-               $sock->push_write($data);
-               $total_out = $lth;
+               if (defined $sock && !$sock->destroyed) {
+                       $sock->push_write($data);
+                       $total_out = $lth;
+               } else {
+                       dbg("_send_stuff $call ending data ignored: $data");
+               }

        }
 }
 
        }
 }
 


@@ -285,7 +292,7 @@ sub _err_will_block {
 sub close_on_empty
 {
        my $conn = shift;
 sub close_on_empty
 {
        my $conn = shift;

-       $conn->{sock}->push_shutdown;
+       $conn->{sock}->on_drain(sub {$conn->disconnect;});

 }
 
 #-----------------------------------------------------------------
 }
 
 #-----------------------------------------------------------------

diff --git a/perl/Version.pm b/perl/Version.pm
index e3905020a2ccd4cb75c0b2c7e1e079e9c093c4e7..580ef44fd62d3a807f256884b15a5dd143a447cc 100644 (file)
--- a/perl/Version.pm
+++ b/perl/Version.pm
@@ -11,7 +11,7 @@ use vars qw($version $subversion $build $gitversion);
 
 $version = '1.56';
 $subversion = '0';
 
 $version = '1.56';
 $subversion = '0';

-$build = '1';
-$gitversion = 'd17f05b';
+$build = '2';
+$gitversion = '38aa5af';

 
 1;
 
 1;