aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Net
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem@fripost.org>2015-07-26 02:42:32 +0200
committerGuilhem Moulin <guilhem@fripost.org>2015-07-26 02:42:32 +0200
commitf3675b5adf9bdb421d668fa7fd894128f2d70a07 (patch)
tree5e965b894bd48acd7a1002d2fc45c418aa3f642b /lib/Net
parent1c78a883849c5ffc4e2fbd84dc912dec18486759 (diff)
Add an option 'logfile' to log debug messages.
Diffstat (limited to 'lib/Net')
-rw-r--r--lib/Net/IMAP/Sync.pm47
1 files changed, 26 insertions, 21 deletions
diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm
index 7c76996..26303a6 100644
--- a/lib/Net/IMAP/Sync.pm
+++ b/lib/Net/IMAP/Sync.pm
@@ -23,6 +23,7 @@ use strict;
use Config::Tiny ();
use IO::Select ();
use List::Util 'first';
+use POSIX 'strftime';
use Socket 'SO_KEEPALIVE';
use Exporter 'import';
@@ -207,9 +208,6 @@ our $IMAP_text;
# advertise "ENABLE" in its CAPABILITY list or does not reply with
# an untagged ENABLED response with all the given extensions.
#
-# - 'STDERR': Where to log debug and informational messages (default:
-# STDERR)
-#
# - 'name': An optional instance name to include in log messages.
#
# - 'read-only': Use only commands that don't modify the server state.
@@ -220,6 +218,8 @@ our $IMAP_text;
# when getting new mails, in addition to (MODSEQ FLAGS INTERNALDATE
# BODY.PEEK[]).
#
+# - 'logger-fd': An optional filehandle to use for debug output.
+#
sub new($%) {
my $class = shift;
my $self = { @_ };
@@ -228,9 +228,6 @@ sub new($%) {
# whether we're allowed to to use read-write command
$self->{'read-only'} = uc ($self->{'read-only'} // 'NO') ne 'YES' ? 0 : 1;
- # where to log
- $self->{STDERR} //= \*STDERR;
-
# the IMAP state: one of 'UNAUTH', 'AUTH', 'SELECTED' or 'LOGOUT'
# (cf RFC 3501 section 3)
$self->{_STATE} = '';
@@ -386,27 +383,35 @@ sub new($%) {
}
-# Close handles when the Net::IMAP::Sync object is destroyed.
+# Log out when the Net::IMAP::Sync object is destroyed.
sub DESTROY($) {
my $self = shift;
if (defined $self->{STDIN} and $self->{STDIN}->opened() and
defined $self->{STDOUT} and $self->{STDOUT}->opened()) {
$self->logout();
}
- $self->{STDERR}->close() if defined $self->{STDERR} and $self->{STDERR}->opened()
- and $self->{STDERR} ne \*STDERR;
}
# $self->log($message, [...])
-# Log a $message.
+# $self->logger($message, [...])
+# Log a $message. The latter method is used to log in the 'logger-fd', and
+# add timestamps.
sub log($@) {
my $self = shift;
return unless @_;
+ $self->logger(@_) if defined $self->{'logger-fd'} and $self->{'logger-fd'} ne \*STDERR;
my $prefix = defined $self->{name} ? $self->{name} : '';
$prefix .= "($self->{_SELECTED})" if $self->{_STATE} eq 'SELECTED';
- $prefix .= ': ';
- $self->{STDERR}->say($prefix, @_);
+ print STDERR $prefix, ': ', @_, "\n";
+}
+sub logger($@) {
+ my $self = shift;
+ return unless @_ and defined $self->{'logger-fd'};
+ my $prefix = strftime "%b %e %H:%M:%S ", localtime;
+ $prefix .= defined "$self->{name}" ? $self->{name} : '';
+ $prefix .= "($self->{_SELECTED})" if $self->{_STATE} eq 'SELECTED';
+ $self->{'logger-fd'}->say($prefix, ': ', @_);
}
@@ -770,8 +775,8 @@ sub set_cache($$%) {
$cache->{$k} = $v;
}
- $self->log("Update last clean state for $mailbox: ".
- '('.join(' ', map {"$_ $cache->{$_}"} keys %$cache).')')
+ $self->logger("Update last clean state for $mailbox: ".
+ '('.join(' ', map {"$_ $cache->{$_}"} keys %$cache).')')
if $self->{debug};
}
@@ -845,8 +850,8 @@ sub next_dirty_mailbox($@) {
my @dirty = grep { (!%mailboxes or $mailboxes{$_}) and $self->is_dirty($_) }
keys %{$self->{_CACHE}};
if ($self->{debug}) {
- @dirty ? $self->log("Dirty mailboxes: ".join(', ', @dirty))
- : $self->log("Clean state!");
+ @dirty ? $self->logger("Dirty mailboxes: ".join(', ', @dirty))
+ : $self->logger("Clean state!");
}
return $dirty[0];
}
@@ -1058,7 +1063,7 @@ sub _getline($;$) {
my $x = $self->{STDOUT}->getline() // $self->panic("Can't read: $!");
$x =~ s/\r\n\z// or $self->panic($x);
- $self->log("S: $msg", $x) if $self->{debug};
+ $self->logger("S: $msg", $x) if $self->{debug};
return $x;
}
@@ -1121,7 +1126,7 @@ sub _send($$;&) {
$litplus //= $self->_capable('LITERAL+') ? '+' : '';
push @command, $str, "{$len$litplus}", "\r\n";
- $self->log($dbg_cmd, $str, "{$len$litplus}") if $self->{debug};
+ $self->logger($dbg_cmd, $str, "{$len$litplus}") if $self->{debug};
$dbg_cmd = 'C: [...]';
unless ($litplus) {
@@ -1134,7 +1139,7 @@ sub _send($$;&) {
push @command, $lit;
}
push @command, $command, "\r\n";
- $self->log($dbg_cmd, $command) if $self->{debug};
+ $self->logger($dbg_cmd, $command) if $self->{debug};
$self->{STDIN}->write(join('',@command)) // $self->panic("Can't write: $!");
$self->{STDIN}->flush();
@@ -1264,7 +1269,7 @@ sub _resp_text($$) {
local $_ = shift;
if (/\A\[ALERT\] $RE_TEXT_CHAR+\z/) {
- print STDERR $_, "\n";
+ $self->log($_);
}
elsif (/\A\[BADCHARSET .*\] $RE_TEXT_CHAR+\z/) {
$self->fail($_);
@@ -1534,7 +1539,7 @@ sub _resp($$;$$$) {
elsif (s/\A\+ //) {
if (defined $callback and $cmd eq 'AUTHENTICATE') {
my $x = $callback->($_);
- print STDERR "C: ", $x, "\n" if $self->{debug};
+ $self->logger("C: ", $x) if $self->{debug};
$self->{STDIN}->write($x."\r\n") // $self->panic("Can't write: $!");
$self->{STDIN}->flush();
}