r25880 - in /branches/upstream/libmail-imapclient-perl/current: Changes META.yml examples/imap_to_mbox.pl lib/Mail/IMAPClient.pm
rmayorga-guest at users.alioth.debian.org
rmayorga-guest at users.alioth.debian.org
Fri Oct 10 02:05:42 UTC 2008
Author: rmayorga-guest
Date: Fri Oct 10 02:05:19 2008
New Revision: 25880
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=25880
Log:
[svn-upgrade] Integrating new upstream version, libmail-imapclient-perl (3.11)
Modified:
branches/upstream/libmail-imapclient-perl/current/Changes
branches/upstream/libmail-imapclient-perl/current/META.yml
branches/upstream/libmail-imapclient-perl/current/examples/imap_to_mbox.pl
branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm
Modified: branches/upstream/libmail-imapclient-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/Changes?rev=25880&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/Changes (original)
+++ branches/upstream/libmail-imapclient-perl/current/Changes Fri Oct 10 02:05:19 2008
@@ -2,6 +2,18 @@
== Revision History for Mail::IMAPClient
All changes from 2.99_01 upward are made by Mark Overmeer. The changes
before that are applied by David Kernen
+
+version 3.11: Wed Oct 8 10:57:31 CEST 2008
+
+ Fixes:
+
+ - some SSL connections process more bytes then needed, which
+ made the select() timeout. Nice fix by [David Sansome]
+ rt.cpan.org#39776
+
+ Improvements:
+
+ - improved example imap_to_mbox by [Ralph Sobek]
version 3.10: Sun Aug 24 21:26:27 CEST 2008
Modified: branches/upstream/libmail-imapclient-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/META.yml?rev=25880&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/META.yml (original)
+++ branches/upstream/libmail-imapclient-perl/current/META.yml Fri Oct 10 02:05:19 2008
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Mail-IMAPClient
-version: 3.10
+version: 3.11
abstract: IMAP4 client library
license: ~
author: ~
Modified: branches/upstream/libmail-imapclient-perl/current/examples/imap_to_mbox.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/examples/imap_to_mbox.pl?rev=25880&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/examples/imap_to_mbox.pl (original)
+++ branches/upstream/libmail-imapclient-perl/current/examples/imap_to_mbox.pl Fri Oct 10 02:05:19 2008
@@ -6,11 +6,27 @@
# DESC: Reads a users IMAP folders, and converts them to mbox
# Good for an interim switch-over from say, Exchange to Cyrus IMAP.
+# $Header: /usr/CvsRepository/Mail/IMAPClient/examples/imap_to_mbox.pl,v 19991216.7 2002/08/23 13:29:48 dkernen Exp $
+
+# History:
+# --------
+# 2008/08/07 - Added SSL support, fixed From header printing, and CR
+# elimination (sobek)
+
# TODO:
-# correct header printing From
-
-use Mail::IMAPClient; # a nice set of perl libs for imap
-use IO::Socket::SSL;
+# -----
+# lsub instead of list option
+
+use warnings;
+use strict;
+
+use Mail::IMAPClient; # a nice set of perl libs for imap
+use IO::Socket::SSL; # for SSL support
+
+use vars qw($opt_h $opt_u $opt_p $opt_P $opt_s $opt_i $opt_f $opt_m $opt_b
+ $opt_c $opt_r $opt_w $opt_W $opt_S $opt_D $opt_U $opt_d $opt_I
+ $opt_n);
+
use Getopt::Std; # for the command-line overrides. good for user
use File::Path; # create full file paths. (yummy!)
use File::Basename; # find a nice basename for a folder.
@@ -20,37 +36,49 @@
sub connect_imap();
sub find_folders();
sub write_folder($$$$);
+sub help();
# Config for the imap migration kit.
-getopts('u:p:P:s:i:f::b:c:W:Sdh');
-
-$SSL = $opt_S || 0;
-$SERVER = $opt_s || 'dell2';
-$USER = $opt_u || 'userid';
-$PASSWORD = $opt_p || 'password';
-$PORT = $opt_P || '143';
-$INBOX_PATH = $opt_i || "/var/mail/$USER";
-$FOLDERS_PATH = $opt_f || "./folders/$USER";
-$DONT_MOVE = $opt_m || '.mailboxlist|Trash|INBOXIIMAP|mlbxl';
-$READ_DELIMITER = $opt_r || '/';
-$WRITE_DELIMITER= $opt_w || '/';
-$WRITE_MODE = $opt_W || '>';
-$BANNED_CHARS = $opt_b || '.|^|%';
-$CR = $opt_c || "\r";
-$DELETE = $opt_D || 0;
-$DEBUG = $opt_d || "0";
-$FAIL = 0;
+getopts('u:p:P:s:i:f:m:b:c:r:w:W:SDUdhIn:') or
+ $opt_h = 1;
+
+my $SSL = $opt_S || 0;
+my $SERVER = $opt_s || 'machine';
+my $USER = $opt_u || 'userid';
+my $PASSWORD = $opt_p || 'password';
+my $PORT = $opt_P || '143';
+my $INBOX_PATH = $opt_i || "/var/mail/$USER";
+my $DOINBOX = $opt_I ? 0 : 1 || 1;
+my $FOLDERS_PATH = $opt_f || "./folders/$USER";
+my $DONT_MOVE = $opt_m || '.mailboxlist|Trash|INBOXIIMAP|mlbxl';
+my $READ_DELIMITER = $opt_r || '/';
+my $WRITE_DELIMITER = $opt_w || '/';
+my $WRITE_MODE = $opt_W || '>';
+my $BANNED_CHARS = $opt_b || '.|^|%';
+my $CR = $opt_c || "\r";
+my $NUMBER = $opt_n || "";
+my $DELETE = $opt_D || 0;
+my $DEBUG = $opt_d || "0";
+my $UNSEEN = $opt_U || 0;
+my $FAIL = 0;
+
+my $imap; # definition for IMAP structure
if ($opt_h) {
# print help here
- print "imap_to_mbox.pl - with the following optional arguments:
+ help();
+}
+
+sub help() {
+ print "imap_to_mbox.pl - with the following optional arguments\:
-S Use an SSL connection (default $SSL)
-s <s> Server specification (default $SERVER)
-u <u> User login (default $USER)
-p <p> User password
-P <p> Server Port (default $PORT)
-i <i> INBOX save path (default $INBOX_PATH)
+ -I skip INBOX (default $DOINBOX)
-f <f> Save path for other folders (default $FOLDERS_PATH)
-m <r> Regexp for IMAP folders not to be saved:
$DONT_MOVE
@@ -58,14 +86,16 @@
-w <w> Write Delimiter (default \"$WRITE_DELIMITER\")
-b <b> Banned chars (default \"$BANNED_CHARS\")
-c <c> Strip CRs from saved files [for Unix] (default \"$CR\")
- -D Delete files downloaded on server
+ -n <n> Receive only <n> messages (Default ".($NUMBER ? "$NUMBER" : "all").")
+ -U Unseen messages Only
+ -D Delete downloaded files on server
-d Debug mode (default $DEBUG)\n";
exit 1;
}
## do our magic tricks ######################################
-connect_imap;
-find_folders;
+connect_imap();
+find_folders();
sub connect_imap()
@@ -76,7 +106,7 @@
if ($opt_S) {
$ssl=IO::Socket::SSL->new(
PeerHost => "$SERVER:imaps"
-# , SSL_version => 'SSLv2'
+# , SSL_version => 'SSLv2' # for older versions of openssl
);
defined $ssl
@@ -103,14 +133,24 @@
my @folders = $imap->folders;
# push(@folders, "INBOX");
- foreach my $folder (@folders)
- { my $message_count = $imap->message_count($folder);
+ foreach my $folder (@folders) {
+ my $message_count;
+
+ if ($folder eq "INBOX" and $DOINBOX == 0) {
+ print "* $folder is unwanted, skipping.\n";
+ next;
+ }
+ if (!$UNSEEN) {
+ $message_count = $imap->message_count($folder);
+ } else {
+ $message_count = $imap->unseen_count($folder) || 0;
+ }
if(! $message_count) {
- print("* $folder is empty, skipping.\n");
+ print "* $folder is empty, skipping.\n";
next;
}
if($folder =~ /$DONT_MOVE/) {
- print("! $folder matches DONT_MOVE ruleset, skipping\n");
+ warn "! $folder matches DONT_MOVE ruleset, skipping\n";
next;
}
@@ -121,8 +161,13 @@
= $new_folder eq "INBOX" ? "$INBOX_PATH"
: "$FOLDERS_PATH/$new_folder";
- printf "x %4i %-45.45s => %s", $message_count, $folder, $path;
- write_folder $folder, $path, 1, $message_count;
+ if ($NUMBER && $NUMBER < $message_count) {
+ printf "x %4i %-45.45s => %s", $NUMBER, $folder, $path;
+ write_folder $folder, $path, 1, $NUMBER;
+ } else {
+ printf "x %4i %-45.45s => %s", $message_count, $folder, $path;
+ write_folder $folder, $path, 1, $message_count;
+ }
}
}
@@ -135,55 +180,59 @@
my $new_dir = dirname $newpath;
my $new_file = basename $newpath;
- -d $new_dir
+ -d $new_dir
or mkpath($new_dir, 0700)
or die "Cannot create $new_dir:$!\n";
- open mbox, $WRITE_MODE, $newpath
+ open my $mbox, $WRITE_MODE, $newpath
or die "Cannot create file $newpath: $!\n";
+ my @msgs = $imap->unseen if $UNSEEN;
+
for (my $i=$first_message; $i<$last_message+1; ++$i)
- { my $date = UnixDate(ParseDate($imap->internaldate($i)),
+ { my $m = ($UNSEEN ? shift @msgs : $i);
+ my $date = UnixDate(ParseDate($imap->internaldate($m)),
"%a %b %e %T %Y");
- my $user = $imap->get_envelope($i)->from_addresses;
- $user =~ s/^.*\<([^>]*)\>/$1/;
+ my $user = $imap->get_envelope($m)->from_addresses;
+ $user =~ s/^.*<([^>]*)>/$1/;
$user = '-' unless $user;
- print '.' if $i%25 == 0;
-
- my $msg_header = $imap->fetch($i, "FAST")
- or warn "Could not fetch header $i from $folder\n";
-
- my $msg_rfc822 = $imap->fetch($i, "RFC822");
+ print '.' if $m%25 == 0;
+
+ my $msg_header = $imap->fetch($m, "FAST")
+ or warn "Could not fetch header $m from $folder\n";
+
+ my $msg_rfc822 = $imap->fetch($m, "RFC822");
unless($msg_rfc822)
- { warn "Could not fetch RFC822 $i from $folder\n";
+ { warn "Could not fetch RFC822 $m from $folder\n";
$FAIL=1
}
- undef $start;
+ undef my $start;
foreach (@$msg_rfc822)
- { if($_ =~ /\: / && !$message)
+ { my $message;
+ if($_ =~ /\: / && !$message)
{ ++$message;
- print mbox "From $user $date\n";
+ print $mbox "From $user $date\n";
}
if(/^\)\r/)
{ undef $message;
- print mbox "\n\n";
+ print $mbox "\n\n";
}
next unless $message;
$_ =~ s/\r$//;
$_ = $imap->Strip_cr($_) if $CR;
- print mbox "$_";
+ print $mbox "$_";
}
if($DELETE && ! $FAIL)
- { $imap->delete_message($i)
+ { $imap->delete_message($m)
or warn "Could not delete_message: $@\n";
$FAIL = 0;
}
}
- close mbox
+ close $mbox
or die "Write errors to $newpath: $!\n";
if($DELETE)
Modified: branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm?rev=25880&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm (original)
+++ branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm Fri Oct 10 02:05:19 2008
@@ -2,7 +2,7 @@
use strict;
package Mail::IMAPClient;
-our $VERSION = '3.10';
+our $VERSION = '3.11';
use Mail::IMAPClient::MessageSet;
@@ -1315,23 +1315,19 @@
)
{ my $transno = $self->Transaction;
- if($timeout)
- { my $rvec = 0;
- vec($rvec, fileno($self->Socket), 1) = 1;
- unless(CORE::select($rvec, undef, $rvec, $timeout))
- { $self->LastError("Tag $transno: Timeout after $timeout seconds"
- . " waiting for data from server");
-
- $self->_record($transno,
- [ $self->_next_index($transno), "ERROR"
- , "$transno * NO Timeout after $timeout seconds " .
- "during read from server"]);
-
- $self->LastError("Timeout after $timeout seconds during "
- . "read from server");
-
- return undef;
- }
+ if($timeout && !_read_more($socket, $timeout))
+ { $self->LastError("Tag $transno: Timeout after $timeout seconds"
+ . " waiting for data from server");
+
+ $self->_record($transno,
+ [ $self->_next_index($transno), "ERROR"
+ , "$transno * NO Timeout after $timeout seconds " .
+ "during read from server"]);
+
+ $self->LastError("Timeout after $timeout seconds during "
+ . "read from server");
+
+ return undef;
}
my $ret = $self->_sysread($socket, \$iBuffer, $readlen,length $iBuffer);
@@ -1385,10 +1381,7 @@
while($expected_size > length $litstring)
{ if($timeout)
- { # wait for data from the the IMAP socket.
- my $rvec = 0;
- vec($rvec, fileno($self->Socket), 1) = 1;
- unless(CORE::select($rvec, undef, $rvec, $timeout))
+ { unless(_read_more($socket, $timeout))
{ $self->LastError("Tag $transno: Timeout waiting for "
. "literal data from server");
return undef;
@@ -1398,7 +1391,7 @@
{ CORE::select(undef, undef, undef, 0.001);
}
- fcntl($socket, F_SETFL, $self->{_fcntl}) #???why
+ fcntl($socket, F_SETFL, $self->{_fcntl}) #???need???
if $fast_io && defined $self->{_fcntl};
my $ret = $self->_sysread($socket, \$litstring
@@ -1453,6 +1446,19 @@
$rm ? $rm->($self, @_) : sysread($fh, $$buf, $len, $off);
}
+sub _read_more($$)
+{ my ($socket, $timeout) = @_;
+
+ # IO::Socket::SSL buffers some data internally, so there might be some
+ # data available from the previous sysread of which the file-handle
+ # (used by select()) doesn't know of.
+ return 1 if $socket->isa("IO::Socket::SSL") && $socket->pending;
+
+ my $rvec = 0;
+ vec($rvec, fileno($socket), 1) = 1;
+ return CORE::select($rvec, undef, $rvec, $timeout);
+}
+
sub _trans_index() { sort {$a <=> $b} keys %{$_[0]->{History}} }
# all default to last transaction
More information about the Pkg-perl-cvs-commits
mailing list