aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Net/IMAP/InterIMAP.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Net/IMAP/InterIMAP.pm')
-rw-r--r--lib/Net/IMAP/InterIMAP.pm17
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) = @_;