+ my $conn = $pkg;
+ unless (ref $pkg) {
+ my $rproc = delete $args{rproc};
+ $conn = $pkg->new($rproc);
+ }
+ $conn->{peerhost} = $to_host;
+ $conn->{peerport} = $to_port;
+ $conn->{sort} = 'Outgoing';
+
+ dbg((ref $conn) . " connecting $conn->{cnum} to $to_host:$to_port") if isdbg('connll');
+
+ my $sock;
+ $conn->{sock} = $sock = Mojo::IOLoop::Client->new;
+ $sock->on(connect => sub {
+ $conn->_on_connect($_[1])
+ } );
+ $sock->on(error => sub {
+ &{$conn->{eproc}}($conn, $_[1]) if exists $conn->{eproc};
+ delete $conn->{sock};
+ $conn->disconnect
+ });
+ $sock->on(close => sub {
+ delete $conn->{sock};
+ $conn->disconnect}
+ );
+
+ # copy any args like on_connect, on_disconnect etc
+ while (my ($k, $v) = each %args) {
+ $conn->{$k} = $v;
+ }
+
+ $sock->connect(address => $to_host, port => $to_port, timeout => $timeout);
+
+ return $conn;
+}
+
+sub start_program
+{
+ my ($conn, $line, $sort) = @_;
+ my $pid;
+
+# local $^F = 10000; # make sure it ain't closed on exec
+# my ($a, $b) = $io_socket->socketpair(AF_UNIX, SOCK_STREAM, PF_UNSPEC);
+# if ($a && $b) {
+# $a->autoflush(1);
+# $b->autoflush(1);
+# $pid = fork;
+# if (defined $pid) {
+# if ($pid) {
+# close $b;
+# $conn->{sock} = $a;
+# $conn->{csort} = $sort;
+# $conn->{lineend} = "\cM" if $sort eq 'ax25';
+# $conn->{pid} = $pid;
+# if ($conn->{rproc}) {
+# my $callback = sub {$conn->_rcv};
+# Msg::set_event_handler ($a, read => $callback);
+# }
+# dbg("connect $conn->{cnum}: started pid: $conn->{pid} as $line") if isdbg('connect');
+# } else {
+# $^W = 0;
+# dbgclose();
+# STDIN->close;
+# STDOUT->close;
+# STDOUT->close;
+# *STDIN = IO::File->new_from_fd($b, 'r') or die;
+# *STDOUT = IO::File->new_from_fd($b, 'w') or die;
+# *STDERR = IO::File->new_from_fd($b, 'w') or die;
+# close $a;
+# unless ($main::is_win) {
+# # $SIG{HUP} = 'IGNORE';
+# $SIG{HUP} = $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = 'DEFAULT';
+# alarm(0);
+# }
+# exec "$line" or dbg("exec '$line' failed $!");
+# }
+# } else {
+# dbg("cannot fork for $line");
+# }
+# } else {
+# dbg("no socket pair $! for $line");
+# }
+ return $pid;
+}
+
+sub disconnect
+{
+ my $conn = shift;
+ my $count = $conn->{disconnecting}++;
+ my $dbg = isdbg('connll');
+ my ($pkg, $fn, $line) = caller if $dbg;
+
+ if ($count >= 2) {
+ dbgtrace((ref $conn) . "::disconnect on call $conn->{call} attempt $conn->{disconnecting} called from ${pkg}::${fn} line $line FORCING CLOSE ") if $dbg;
+ _close_it($conn);
+ return;
+ }
+ dbg((ref $conn) . "::disconnect on call $conn->{call} attempt $conn->{disconnecting} called from ${pkg}::${fn} line $line ") if $dbg;
+ return if $count;
+
+ # remove this conn from the active queue
+ # be careful to delete the correct one
+ my $call;
+ if ($call = $conn->{call}) {
+ my $ref = $conns{$call};
+ delete $conns{$call} if $ref && $ref == $conn;
+ }
+ $call ||= 'unallocated';
+
+ $delqueue{$conn} = $conn; # save this connection until everything is finished
+ my $sock = $conn->{sock};
+ if ($sock) {
+ if ($sock->{buffer}) {
+ my $lth = length $sock->{buffer};
+ Mojo::IOLoop->timer($disc_waittime, sub {
+ dbg("Buffer contained $lth characters, coordinated for $disc_waittime secs, now disconnecting $call") if $dbg;
+ _close_it($conn);
+ });
+ } else {
+ dbg("Buffer empty, just close $call") if $dbg;
+ _close_it($conn);
+ }
+ }
+ else {
+ dbg((ref $conn) . " socket missing on $conn->{call}") if $dbg;
+ _close_it($conn);
+ }