aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Net
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Net')
-rw-r--r--lib/Net/IMAP/InterIMAP.pm73
1 files changed, 47 insertions, 26 deletions
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 2d1f644..bb27009 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -17,6 +17,7 @@
#----------------------------------------------------------------------
package Net::IMAP::InterIMAP v0.0.5;
+use v5.10.0;
use warnings;
use strict;
@@ -280,7 +281,8 @@ our $IMAP_text;
#
# - 'name': An optional instance name to include in log messages.
#
-# - 'logger-fd': An optional filehandle to use for debug output.
+# - 'logger-fd': An optional filehandle to use for debug output
+# (default: STDERR).
#
# - 'keepalive': Whether to enable sending of keep-alive messages.
# (type=imap or type=imaps).
@@ -289,6 +291,7 @@ sub new($%) {
my $class = shift;
my $self = { @_ };
bless $self, $class;
+ require 'Time/HiRes.pm' if defined $self->{'logger-fd'};
# the IMAP state: one of 'UNAUTH', 'AUTH', 'SELECTED' or 'LOGOUT'
# (cf RFC 3501 section 3)
@@ -378,11 +381,6 @@ sub new($%) {
# are considered.
$self->{_MODIFIED} = {};
- if (defined $self->{'logger-fd'} and defined $self->{'logger-fd'}->fileno
- and $self->{'logger-fd'}->fileno != fileno STDERR) {
- require 'Time/HiRes.pm';
- }
-
# wait for the greeting
my $x = $self->_getline();
$x =~ s/\A\* (OK|PREAUTH) // or $self->panic($x);
@@ -539,32 +537,55 @@ sub DESTROY($) {
# $self->log($message, [...])
# $self->logger($message, [...])
-# Log a $message. The latter method is used to log in the 'logger-fd', and
-# add timestamps.
+# Log a $message. The latter method is used to log in the 'logger-fd'
+# (and adds timestamps).
sub log($@) {
my $self = shift;
return unless @_;
- $self->logger(@_) if defined $self->{'logger-fd'} and defined $self->{'logger-fd'}->fileno
- and $self->{'logger-fd'}->fileno != fileno STDERR;
- my $prefix = $self->{name} // '';
- $prefix .= "($self->{_SELECTED})" if $self->{_STATE} eq 'SELECTED';
- $prefix .= ': ' unless $prefix eq '';
- print STDERR $prefix, @_, "\n";
+ my $prefix = _logger_prefix($self);
+ if (defined (my $fd = $self->{'logger-fd'})) {
+ say $fd _date(), " ", $prefix, @_;
+ }
+ say STDERR $prefix, @_;
}
sub logger($@) {
my $self = shift;
- return unless @_ and defined $self->{'logger-fd'};
- my $prefix = '';
- if (defined $self->{'logger-fd'}->fileno and defined $self->{'logger-fd'}->fileno
- and $self->{'logger-fd'}->fileno != fileno STDERR) {
- my ($s, $us) = Time::HiRes::gettimeofday();
- $prefix = POSIX::strftime("%b %e %H:%M:%S", localtime($s)).".$us";
- $prefix .= ' ' if defined $self->{name} or $self->{_STATE} eq 'SELECTED';
- }
- $prefix .= $self->{name} if defined $self->{name};
- $prefix .= "($self->{_SELECTED})" if $self->{_STATE} eq 'SELECTED';
- $prefix .= ': ' unless $prefix eq '';
- $self->{'logger-fd'}->say($prefix, @_);
+ return unless @_;
+ my $prefix = _logger_prefix($self);
+ if (defined (my $fd = $self->{'logger-fd'})) {
+ say $fd _date(), " ", $prefix, @_;
+ } else {
+ say STDERR $prefix, @_;
+ }
+}
+sub _date() {
+ my ($s, $us) = Time::HiRes::gettimeofday();
+ my $t = POSIX::strftime("%b %e %H:%M:%S", localtime($s));
+ return "$t.$us"; # millisecond precision
+}
+
+# $self->_logger_prefix()
+# Format a prefix for logging with printf(3)-like sequences:
+# %n: the object name
+# %m: mailbox, either explicit named or selected
+sub _logger_prefix($) {
+ my $self = shift;
+ my $format = $self->{'logger-prefix'} // return "";
+
+ my %seq = ( "%" => "%", m => $self->{mailbox}, n => $self->{name} );
+ $seq{m} //= $self->{_SELECTED} // die
+ if defined $self->{_STATE} and $self->{_STATE} eq 'SELECTED';
+
+ do {} while
+ # rewrite conditionals (loop because of nesting)
+ $format =~ s#%\? ([[:alpha:]]) \?
+ ( (?: (?> (?: [^%&?\\] | %[^?] | \\[&?\\] )+ ) | (?R) )* )
+ (?: \& ( (?: (?> (?: [^%&?\\] | %[^?] | \\[&?\\] )+ ) | (?R) )*) )?
+ \?# ($seq{$1} // "") ne "" ? $2 : ($3 // "") #agex;
+
+ $format =~ s#\\([&?\\])#$1#g; # unescape remaining '&', '?' and '\'
+ $format =~ s#%([%mn])# $seq{$1} #ge;
+ return $format;
}