diff options
| -rw-r--r-- | Changelog | 5 | ||||
| -rwxr-xr-x | interimap | 5 | ||||
| -rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 42 |
3 files changed, 38 insertions, 14 deletions
@@ -1,4 +1,4 @@ -interimap (0.2) upstream +interimap (0.2) upstream; * Add support for the IMAP COMPRESS extension [RFC4978]. By default enabled for the remote server, and disabled for the local server. @@ -10,7 +10,8 @@ interimap (0.2) upstream default if both the local and remote servers advertize "BINARY". Can be disabled by adding 'use-binary=NO' to the default section in the configuration file. - * Exit with return value 0 when receiving a TERM signal. + * Exit with return value 0 when receiving a SIGTERM. + * Print IMAP traffic stats when receiving a SIGHUP. -- Guilhem Moulin <guilhem@guilhem.org> Wed, 09 Sep 2015 00:44:35 +0200 @@ -118,8 +118,9 @@ sub cleanup() { close $LOGGER_FD if defined $LOGGER_FD; $DBH->disconnect() if defined $DBH; } -$SIG{$_} = sub { msg(undef, $!); cleanup(); exit 1; } foreach qw/INT/; -$SIG{$_} = sub { cleanup(); exit 0; } foreach qw/HUP TERM/; +$SIG{INT} = sub { msg(undef, $!); cleanup(); exit 1; }; +$SIG{TERM} = sub { cleanup(); exit 0; }; +$SIG{HUP} = sub { $_->stats() foreach grep defined, ($lIMAP, $rIMAP); }; ############################################################################# diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 076ec19..4222c78 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -453,6 +453,22 @@ sub new($%) { } +# Print traffic statistics +sub stats($) { + my $self = shift; + my $msg = 'IMAP traffic (bytes):'; + $msg .= ' recv '._kibi($self->{_OUTCOUNT}); + $msg .= ' (compr. '._kibi($self->{_OUTRAWCOUNT}). + ', factor '.sprintf('%.2f', $self->{_OUTRAWCOUNT}/$self->{_OUTCOUNT}).')' + if defined $self->{_Z_DEFLATE} and $self->{_OUTCOUNT} > 0; + $msg .= ' sent '._kibi($self->{_INCOUNT}); + $msg .= ' (compr. '._kibi($self->{_INRAWCOUNT}). + ', factor '.sprintf('%.2f', $self->{_INRAWCOUNT}/$self->{_INCOUNT}).')' + if defined $self->{_Z_DEFLATE} and $self->{_INCOUNT} > 0; + $self->log($msg); +} + + # Log out when the Net::IMAP::InterIMAP object is destroyed. sub DESTROY($) { my $self = shift; @@ -462,16 +478,7 @@ sub DESTROY($) { $self->{$_}->close() if defined $self->{$_} and $self->{$_}->opened(); } - unless ($self->{quiet}) { - my $msg = "Connection closed"; - $msg .= " in=$self->{_INCOUNT}"; - $msg .= " (raw=$self->{_INRAWCOUNT}, ratio ".sprintf('%.2f', $self->{_INRAWCOUNT}/$self->{_INCOUNT}).")" - if defined $self->{_INRAWCOUNT} and $self->{_INCOUNT} > 0 and $self->{_INCOUNT} != $self->{_INRAWCOUNT}; - $msg .= ", out=$self->{_OUTCOUNT}"; - $msg .= " (raw=$self->{_OUTRAWCOUNT}, ratio ".sprintf('%.2f', $self->{_OUTRAWCOUNT}/$self->{_OUTCOUNT}).")" - if defined $self->{_OUTRAWCOUNT} and $self->{_OUTCOUNT} > 0 and $self->{_OUTCOUNT} != $self->{_OUTRAWCOUNT}; - $self->log($msg); - } + $self->stats() unless $self->{quiet}; } @@ -1542,6 +1549,21 @@ sub _select_or_examine($$$;$$) { } +sub _kibi($) { + my $n = shift; + if ($n < 1024) { + $n; + } elsif ($n < 1048576) { + sprintf '%.2fK', $n / 1024.; + } elsif ($n < 1073741824) { + sprintf '%.2fM', $n / 1048576.; + } else { + sprintf '%.2fG', $n / 1073741824.; + } + +} + + ############################################################################# # Parsing methods |