diff options
Diffstat (limited to 'lib/Net')
| -rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 17 | 
1 files changed, 11 insertions, 6 deletions
| diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 1dd54b7..19895c4 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -26,7 +26,8 @@ use Errno qw/EEXIST EINTR/;  use Net::SSLeay 1.73 ();  use List::Util qw/all first/;  use POSIX ':signal_h'; -use Socket qw/SOCK_STREAM SOCK_RAW IPPROTO_TCP AF_UNIX AF_INET AF_INET6 PF_UNSPEC SOCK_CLOEXEC :addrinfo/; +use Socket qw/SOCK_STREAM SOCK_RAW SOCK_CLOEXEC IPPROTO_TCP SHUT_RDWR +              AF_UNIX AF_INET AF_INET6 PF_UNSPEC :addrinfo/;  use Exporter 'import';  BEGIN { @@ -506,7 +507,7 @@ sub stats($) {  } -# Log out when the Net::IMAP::InterIMAP object is destroyed. +# Destroy a Net::IMAP::InterIMAP object.  sub DESTROY($) {      my $self = shift;      $self->{_STATE} = 'LOGOUT'; @@ -514,8 +515,12 @@ sub DESTROY($) {      Net::SSLeay::free($self->{_SSL}) if defined $self->{_SSL};      Net::SSLeay::CTX_free($self->{_SSL_CTX}) if defined $self->{_SSL_CTX}; -    shutdown($self->{S}, 2) if $self->{type} ne 'tunnel' and defined $self->{S}; -    $self->{S}->close() if defined $self->{S} and $self->{S}->opened(); +    if (defined (my $s = $self->{S})) { +        # for type=tunnel we assume the child won't linger around once +        # we close its standard input and output. +        shutdown($s, SHUT_RDWR); +        $s->close() if $s->opened(); +    }      $self->stats() unless $self->{quiet};  } @@ -606,7 +611,7 @@ sub incapable($@) {  # $self->search($criterion) -#   Issue an UID SEARCH command with the given $criterion.  For the "normal" +#   Issue a UID SEARCH command with the given $criterion.  For the "normal"  #   UID SEARCH command from RFC 3501, return the list of matching UIDs;  #   for the extended UID SEARCH command from RFC 4731 (ensuring ESEARCH  #   capability is the caller's responsibility), return an optional "UID" @@ -917,7 +922,7 @@ sub append($$@) {  # $self->fetch($set, $flags, [$callback]) -#   Issue an UID FETCH command with the given UID $set, $flags, and +#   Issue a UID FETCH command with the given UID $set, $flags, and  #   optional $callback.  sub fetch($$$;&) {      my ($self, $set, $flags, $callback) = @_; | 
