Hello community,
here is the log from the commit of package perl-Mail-IMAPClient for
openSUSE:Factory checked in at 2019-01-28 20:48:52
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Mail-IMAPClient (Old)
and /work/SRC/openSUSE:Factory/.perl-Mail-IMAPClient.new.28833 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Mail-IMAPClient"
Mon Jan 28 20:48:52 2019 rev:2 rq:668908 version:3.40
Changes:
--------
---
/work/SRC/openSUSE:Factory/perl-Mail-IMAPClient/perl-Mail-IMAPClient.changes
2017-09-04 12:30:13.842904458 +0200
+++
/work/SRC/openSUSE:Factory/.perl-Mail-IMAPClient.new.28833/perl-Mail-IMAPClient.changes
2019-01-28 20:49:49.553817792 +0100
@@ -1,0 +2,47 @@
+Sat Jan 19 13:12:46 UTC 2019 - Luigi Baldoni <[email protected]>
+
+- Fixed shebangs in example scripts
+
+-------------------------------------------------------------------
+Thu Dec 6 15:51:38 UTC 2018 - Stephan Kulow <[email protected]>
+
+- updated to 3.40
+ see /usr/share/doc/packages/perl-Mail-IMAPClient/Changes
+
+ version 3.40: Thu Dec 6 01:44:16 UTC 2018
+ - rt.cpan.org#122373 support IPv6 by using IO::Socket::IP over
IO::Socket::INET
+ [Gilles Lamiral and Mark Overmeer]
+ - rt.cpan.org#127103 flags() undef value as an ARRAY reference on a
bogus message
+ [Gilles Lamiral]
+ - rt.cpan.org#124523 update examples/populate_mailbox.pl timegm usage
+ [Bernhard M. W.]
+ - t/capability.t: added first set of tests
+ - t/quota.t: minor fix when tests skipped
+
+ version 3.39: Fri Feb 3 00:43:00 UTC 2017
+ - rt.cpan.org#115726: uninitialized value via fetch_hash
+ [Malte Stretz]
+ - rt.cpan.org#119523: better error reporting on failed TLS connections
+ [Matthew Horsfall]
+ - rt.cpan.org#114904: document noop()
+ [Glenn Golden]
+ - rt.cpan.org#97718: (redux) never retry DONE
+ [Laurence Darby]
+ - _imap_command() new doretry => 0|1 option to suppress/allow retry
+ - updated copyright for 2017
+
+ version 3.38: Tue Feb 9 02:48:21 UTC 2016
+ - rt.cpan.org#107592: redact credentials via debug if !Showcredentials
+ [Gilles Lamiral]
+ - rt.cpan.org#110273: failure to quote password values
+ (regression introduced in 3.36 via fix for rt.cpan.org#100601)
+ [Gilles Lamiral]
+ - rt.cpan.org#107593: allow getquota("")
+ - *Quote() now returns qq("") for defined but empty values
+ - rt.cpan.org#107011: fix folders_hash() docs and usage in is_parent()
+ [Gilles Lamiral]
+ - rt.cpan.org#106500: split UID EXPUNGE with a large sequence set
+ - added t/quota.t and t/lib/MyTest.pm for testing
+ - updated copyright for 2016
+
+-------------------------------------------------------------------
Old:
----
Mail-IMAPClient-3.37.tar.gz
New:
----
Mail-IMAPClient-3.40.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Mail-IMAPClient.spec ++++++
--- /var/tmp/diff_new_pack.fedhSs/_old 2019-01-28 20:49:50.133817180 +0100
+++ /var/tmp/diff_new_pack.fedhSs/_new 2019-01-28 20:49:50.137817176 +0100
@@ -1,7 +1,7 @@
#
# spec file for package perl-Mail-IMAPClient
#
-# Copyright (c) 2016 SUSE LINUX Products GmbH, Nuernberg, Germany.
+# Copyright (c) 2019 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -12,29 +12,25 @@
# license that conforms to the Open Source Definition (Version 1.9)
# published by the Open Source Initiative.
-# Please submit bugfixes or comments via http://bugs.opensuse.org/
+# Please submit bugfixes or comments via https://bugs.opensuse.org/
#
Name: perl-Mail-IMAPClient
-Version: 3.37
+Version: 3.40
Release: 0
%define cpan_name Mail-IMAPClient
Summary: An IMAP Client API
-License: Artistic-1.0 or GPL-1.0+
+License: Artistic-1.0 OR GPL-1.0-or-later
Group: Development/Libraries/Perl
-Url: http://search.cpan.org/dist/Mail-IMAPClient/
-Source0:
http://www.cpan.org/authors/id/P/PL/PLOBBES/%{cpan_name}-%{version}.tar.gz
+Url: https://metacpan.org/release/%{cpan_name}
+Source0:
https://cpan.metacpan.org/authors/id/P/PL/PLOBBES/%{cpan_name}-%{version}.tar.gz
Source1: cpanspec.yml
BuildArch: noarch
BuildRoot: %{_tmppath}/%{name}-%{version}-build
BuildRequires: perl
BuildRequires: perl-macros
-BuildRequires: perl(version) >= 0.77
-#
-BuildRequires: perl(IO::Socket::INET) >= 1.26
BuildRequires: perl(Parse::RecDescent) >= 1.94
-Requires: perl(IO::Socket::INET) >= 1.26
Requires: perl(Parse::RecDescent) >= 1.94
%{perl_requires}
@@ -43,11 +39,11 @@
interacting with IMAP message stores.
The module is used by constructing or instantiating a new IMAPClient object
-via the the /new manpage constructor method. Once the object has been
-instantiated, the the /connect manpage method is either implicitly or
-explicitly called. At that point methods are available that implement the
-IMAP client commands as specified in *RFC3501*. When processing is
-complete, the the /logout manpage object method should be called.
+via the new constructor method. Once the object has been instantiated, the
+connect method is either implicitly or explicitly called. At that point
+methods are available that implement the IMAP client commands as specified
+in *RFC3501*. When processing is complete, the logout object method should
+be called.
This documentation is not meant to be a replacement for RFC3501 nor any
other IMAP related RFCs.
@@ -58,14 +54,19 @@
%prep
%setup -q -n %{cpan_name}-%{version}
-find . -type f -print0 | xargs -0 chmod 644
+find . -type f ! -name \*.pl -print0 | xargs -0 chmod 644
+# fix shebang
+for f in examples/*.pl
+do
+ sed -i 's|^#!/usr/local/bin/perl|%{__perl}|' ${f}
+done
%build
-%{__perl} Makefile.PL INSTALLDIRS=vendor
-%{__make} %{?_smp_mflags}
+perl Makefile.PL INSTALLDIRS=vendor
+make %{?_smp_mflags}
%check
-%{__make} test
+make test
%install
%perl_make_install
++++++ Mail-IMAPClient-3.37.tar.gz -> Mail-IMAPClient-3.40.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Mail-IMAPClient-3.37/Changes
new/Mail-IMAPClient-3.40/Changes
--- old/Mail-IMAPClient-3.37/Changes 2015-08-14 19:23:31.000000000 +0200
+++ new/Mail-IMAPClient-3.40/Changes 2018-12-06 02:44:28.000000000 +0100
@@ -5,6 +5,42 @@
Changes from 0.09 to 2.99_01 made by David Kernen
- Potential compatibility issues from 3.17+ highlighted with '*'
+version 3.40: Thu Dec 6 01:44:16 UTC 2018
+ - rt.cpan.org#122373 support IPv6 by using IO::Socket::IP over
IO::Socket::INET
+ [Gilles Lamiral and Mark Overmeer]
+ - rt.cpan.org#127103 flags() undef value as an ARRAY reference on a
bogus message
+ [Gilles Lamiral]
+ - rt.cpan.org#124523 update examples/populate_mailbox.pl timegm usage
+ [Bernhard M. W.]
+ - t/capability.t: added first set of tests
+ - t/quota.t: minor fix when tests skipped
+
+version 3.39: Fri Feb 3 00:43:00 UTC 2017
+ - rt.cpan.org#115726: uninitialized value via fetch_hash
+ [Malte Stretz]
+ - rt.cpan.org#119523: better error reporting on failed TLS connections
+ [Matthew Horsfall]
+ - rt.cpan.org#114904: document noop()
+ [Glenn Golden]
+ - rt.cpan.org#97718: (redux) never retry DONE
+ [Laurence Darby]
+ - _imap_command() new doretry => 0|1 option to suppress/allow retry
+ - updated copyright for 2017
+
+version 3.38: Tue Feb 9 02:48:21 UTC 2016
+ - rt.cpan.org#107592: redact credentials via debug if !Showcredentials
+ [Gilles Lamiral]
+ - rt.cpan.org#110273: failure to quote password values
+ (regression introduced in 3.36 via fix for rt.cpan.org#100601)
+ [Gilles Lamiral]
+ - rt.cpan.org#107593: allow getquota("")
+ - *Quote() now returns qq("") for defined but empty values
+ - rt.cpan.org#107011: fix folders_hash() docs and usage in is_parent()
+ [Gilles Lamiral]
+ - rt.cpan.org#106500: split UID EXPUNGE with a large sequence set
+ - added t/quota.t and t/lib/MyTest.pm for testing
+ - updated copyright for 2016
+
version 3.37: Fri Aug 14 11:04:53 EDT 2015
- regex fix in rt.cpan.org#96575 required Perl 5.10
updated regex to be backwards compatible with Perl 5.8
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Mail-IMAPClient-3.37/MANIFEST
new/Mail-IMAPClient-3.40/MANIFEST
--- old/Mail-IMAPClient-3.37/MANIFEST 2015-08-14 19:23:43.000000000 +0200
+++ new/Mail-IMAPClient-3.40/MANIFEST 2018-12-06 02:51:08.000000000 +0100
@@ -31,8 +31,10 @@
t/body_string.t
t/bodystructure.t
t/fetch_hash.t
+t/lib/MyTest.pm
t/messageset.t
t/pod.t
+t/quota.t
t/simple.t
t/thread.t
test_template.txt
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Mail-IMAPClient-3.37/META.json
new/Mail-IMAPClient-3.40/META.json
--- old/Mail-IMAPClient-3.37/META.json 2015-08-14 19:23:43.000000000 +0200
+++ new/Mail-IMAPClient-3.40/META.json 2018-12-06 02:51:08.000000000 +0100
@@ -1,16 +1,16 @@
{
"abstract" : "IMAP4 client library",
"author" : [
- "Phil Pearl (Lobbes) <[email protected]>"
+ "Phil Pearl (Lobbes) <[email protected]>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter
version 2.120921",
+ "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter
version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec";,
- "version" : "2"
+ "version" : 2
},
"name" : "Mail-IMAPClient",
"no_index" : {
@@ -52,5 +52,6 @@
"resources" : {
"homepage" : "http://sourceforge.net/projects/mail-imapclient/";
},
- "version" : "3.37"
+ "version" : "3.40",
+ "x_serialization_backend" : "JSON::PP version 2.97001"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Mail-IMAPClient-3.37/META.yml
new/Mail-IMAPClient-3.40/META.yml
--- old/Mail-IMAPClient-3.37/META.yml 2015-08-14 19:23:43.000000000 +0200
+++ new/Mail-IMAPClient-3.40/META.yml 2018-12-06 02:51:08.000000000 +0100
@@ -1,36 +1,37 @@
---
abstract: 'IMAP4 client library'
author:
- - 'Phil Pearl (Lobbes) <[email protected]>'
+ - 'Phil Pearl (Lobbes) <[email protected]>'
build_requires:
- ExtUtils::MakeMaker: 0
+ ExtUtils::MakeMaker: '0'
configure_requires:
- ExtUtils::MakeMaker: 0
+ ExtUtils::MakeMaker: '0'
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version
2.120921'
+generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version
2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ version: '1.4'
name: Mail-IMAPClient
no_index:
directory:
- t
- inc
requires:
- Carp: 0
- Errno: 0
- Fcntl: 0
- File::Temp: 0
- IO::File: 0
- IO::Select: 0
- IO::Socket: 0
- IO::Socket::INET: 1.26
- List::Util: 0
- MIME::Base64: 0
- Parse::RecDescent: 1.94
- Test::More: 0
- perl: 5.008
+ Carp: '0'
+ Errno: '0'
+ Fcntl: '0'
+ File::Temp: '0'
+ IO::File: '0'
+ IO::Select: '0'
+ IO::Socket: '0'
+ IO::Socket::INET: '1.26'
+ List::Util: '0'
+ MIME::Base64: '0'
+ Parse::RecDescent: '1.94'
+ Test::More: '0'
+ perl: '5.008'
resources:
homepage: http://sourceforge.net/projects/mail-imapclient/
-version: 3.37
+version: '3.40'
+x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Mail-IMAPClient-3.37/Makefile.PL
new/Mail-IMAPClient-3.40/Makefile.PL
--- old/Mail-IMAPClient-3.37/Makefile.PL 2015-08-14 19:23:31.000000000
+0200
+++ new/Mail-IMAPClient-3.40/Makefile.PL 2018-09-27 02:59:20.000000000
+0200
@@ -11,6 +11,7 @@
"Compress::Zlib" => { for => "COMPRESS DEFLATE support" },
"Digest::HMAC_MD5" => { for => "Authmechanism 'CRAM-MD5'" },
"Digest::MD5" => { for => "Authmechanism 'DIGEST-MD5'" },
+ "IO::Socket::IP" => { for => "IPv6 support" },
"IO::Socket::SSL" => { for => "SSL enabled connections (Ssl => 1)" },
"Test::Pod" => { for => "Pod tests", ver => "1.00" },
);
@@ -57,7 +58,7 @@
WriteMakefile(
NAME => 'Mail::IMAPClient',
- AUTHOR => 'Phil Pearl (Lobbes) <[email protected]>',
+ AUTHOR => 'Phil Pearl (Lobbes) <[email protected]>',
ABSTRACT => 'IMAP4 client library',
VERSION_FROM => 'lib/Mail/IMAPClient.pm',
LICENSE => 'perl',
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Mail-IMAPClient-3.37/README
new/Mail-IMAPClient-3.40/README
--- old/Mail-IMAPClient-3.37/README 2015-08-14 19:23:31.000000000 +0200
+++ new/Mail-IMAPClient-3.40/README 2017-02-02 23:04:55.000000000 +0100
@@ -84,7 +84,7 @@
=====================
Copyright (C) 1999-2003 The Kernen Group, Inc.
Copyright (C) 2007-2009 Mark Overmeer
-Copyright (C) 2010-2015 Phil Pearl (Lobbes)
+Copyright (C) 2010-2017 Phil Pearl (Lobbes)
All rights reserved.
This library is free software; you can redistribute it and/or modify
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Mail-IMAPClient-3.37/examples/populate_mailbox.pl
new/Mail-IMAPClient-3.40/examples/populate_mailbox.pl
--- old/Mail-IMAPClient-3.37/examples/populate_mailbox.pl 2015-08-14
19:23:31.000000000 +0200
+++ new/Mail-IMAPClient-3.40/examples/populate_mailbox.pl 2018-03-12
15:04:01.000000000 +0100
@@ -1,123 +1,124 @@
-#!/usr/local/bin/perl
-#$Id$ #
-use Time::Local
;
-use FileHandle ;
-use File::Copy ;
+#!/usr/bin/perl
+
+use Time::Local;
+use FileHandle;
+use File::Copy;
use Mail::IMAPClient;
-use Sys::Hostname ;
- #
-my $default_user = 'default' ;
-my $default_pswd = 'default' ;
- #
-#########################################################################
-# ARGS: DATE = YYYYMMDDHHMM (defaults to current system date) #
-# UID = IMAP account id (defaults to $default_user) #
-# PSWD = uid's password (defaults to $default_pswd) #
-# HOST = Target host (defaults to localhost) #
-# CLEAN = 1 (defaults to 0; used to clean out mailbox 1st) #
-# CLEANONLY= 1 (defaults to 0; if 1 then only CLEAN is done) #
-# DOMAIN = x.com (no default) the mail domain for UID's address #
-# #
-# EG: populate_mailbox.pl DATE=200001010100 UID=testuser #
-# #
-#########################################################################
- #
-(my($x)= join(" ",@ARGV)) ;
-$x=~s~=~ ~g ;
-chomp($x) ;
- #
-my %hash = split(/\s+/, $x) if $x ;
- #
-while (my ($k,$v) = each %hash ) {
- $hash{uc $k} = $v ;
- }
-
-while (my ($k,$v) = each %hash ) {
- delete $hash{$k} if $k =~ tr/[a-z]// ;
- }
- ;
-$hash{UID} ||= "$default_user" ;
-$hash{PSWD} ||= "$default_pswd" ;
-$hash{HOST} ||= hostname ;
- #
-while (my ($k,$v) = each %hash ) {
- print "Running with $k set to $v\n" ;
- }
- #
-my $domain = $hash{DOMAIN} or die "No mail domain provided.\n" ;
-my $now = seconds($hash{DATE}) || time ;
- #
-my $six = $now - ( 6 * 24 * 60 * 60 ) ;
-my $seven = $now - ( 7 * 24 * 60 * 60 ) ;
-my $notthirty = $now - ( 29 * 24 * 60 * 60 ) ;
-my $thirty = $now - ( 30 * 24 * 60 * 60 ) ;
-my $notsixty = $now - ( 59 * 24 * 60 * 60 ) ;
-my $sixty = $now - ( 60 * 24 * 60 * 60 ) ;
-my $notd365 = $now - ( 364 * 24 * 60 * 60 ) ;
-my $d365 = $now - ( 365 * 24 * 60 * 60 ) ;
- #
-$hash{SUBJECTS} = [ "Sixty days old", "Less than sixty days old" ,
- "365 days old", "Less than 365 days old" ,
- "Trash/Incinerator -- 7 days old" ,
- "Sent -- 29 days old" ,
- "Sent -- 30 days old" ,
- "Trash -- 6 days old" ,
- ] ;
-$hash{FOLDERS} = [ "Sent", "INBOX", "Trash" ,
- "365_folder", "Trash/Incinerator" ,
- "not_365_folder" ,
- ] ;
- #
-&clean_mailbox if $hash{CLEANONLY} || $hash{CLEAN}
;
-exit if $hash{CLEANONLY} ;
- #
-#send to: date: subject: #
-#-------- --- ----- --------- #
-sendmail( $hash{UID}, $sixty, "Sixty days old" ) ;
-sendmail( $hash{UID}, $notsixty, "Less than sixty days old") ;
-sendmail( $hash{UID}, $d365, "365 days old" ) ;
-sendmail( $hash{UID}, $notd365, "Less than 365 days old" ) ;
- #
-populate_trash("Trash/Incinerator",$hash{UID}, $seven, 7 ) ;
-populate_trash( "Trash" , $hash{UID}, $six, 6 ) ;
-populate_trash( "Sent" , $hash{UID}, $thirty, 30 ) ;
-populate_trash( "Sent" , $hash{UID}, $notthirty, 29 ) ;
- #
-movemail( "365 days old" ,
- "365_folder" ) ;
- #
-movemail( "Less than 365 days old" ,
- "not_365_folder" ) ;
- #
-exit ;
- #
- #
-sub seconds {
- my $d = shift or return undef ;
- my($yy,$moy,$dom,$hr,$min) =
- #
- $d =~ m! ^ # anchor at start #
- (\d\d\d\d) # year #
- (\d\d) # month #
- (\d\d) # day #
- (\d\d) # hour #
- (\d\d) # minute #
- !x ;
- #
- return timegm(0,$min,$hr,$dom,$moy-1,($yy>99?$yy-1900:$yy)) ;
- }
- #
-sub sendmail {
- #
- my($to,$date,$subject) = @_ ;
- my $text = <<EOTEXT ;
-To: $to\@$hash{DOMAIN}
+use Sys::Hostname;
+
+my $default_user = 'default';
+my $default_pswd = 'default';
+
+###
+# ARGS: DATE = YYYYMMDDHHMM (defaults to current system date)
+# UID = IMAP account id (defaults to $default_user)
+# PSWD = uid's password (defaults to $default_pswd)
+# HOST = Target host (defaults to localhost)
+# CLEAN = 1 (defaults to 0; used to clean out mailbox 1st)
+# CLEANONLY= 1 (defaults to 0; if 1 then only CLEAN is done)
+# DOMAIN = x.com (no default) the mail domain for UID's address
+#
+# EG: populate_mailbox.pl DATE=200001010100 UID=testuser
+###
+
+( my ($x) = join( " ", @ARGV ) );
+$x =~ s~=~ ~g;
+chomp($x);
+
+my %hash = split( /\s+/, $x ) if $x;
+
+while ( my ( $k, $v ) = each %hash ) {
+ $hash{ uc $k } = $v;
+}
+
+while ( my ( $k, $v ) = each %hash ) {
+ delete $hash{$k} if $k =~ tr/[a-z]//;
+}
+
+$hash{UID} ||= "$default_user";
+$hash{PSWD} ||= "$default_pswd";
+$hash{HOST} ||= hostname;
+
+while ( my ( $k, $v ) = each %hash ) {
+ print "Running with $k set to $v\n";
+}
+
+my $domain = $hash{DOMAIN} or die "No mail domain provided.\n";
+my $now = seconds( $hash{DATE} ) || time;
+
+my $six = $now - ( 6 * 24 * 60 * 60 );
+my $seven = $now - ( 7 * 24 * 60 * 60 );
+my $notthirty = $now - ( 29 * 24 * 60 * 60 );
+my $thirty = $now - ( 30 * 24 * 60 * 60 );
+my $notsixty = $now - ( 59 * 24 * 60 * 60 );
+my $sixty = $now - ( 60 * 24 * 60 * 60 );
+my $notd365 = $now - ( 364 * 24 * 60 * 60 );
+my $d365 = $now - ( 365 * 24 * 60 * 60 );
+
+$hash{SUBJECTS} = [
+ "Sixty days old",
+ "Less than sixty days old",
+ "365 days old",
+ "Less than 365 days old",
+ "Trash/Incinerator -- 7 days old",
+ "Sent -- 29 days old",
+ "Sent -- 30 days old",
+ "Trash -- 6 days old",
+];
+
+$hash{FOLDERS} = [
+ "Sent", "INBOX",
+ "Trash", "365_folder",
+ "Trash/Incinerator", "not_365_folder",
+];
+
+&clean_mailbox if $hash{CLEANONLY} || $hash{CLEAN};
+exit if $hash{CLEANONLY};
+
+# send to: date: subject:
+# -------- --- ----- ---------
+sendmail( $hash{UID}, $sixty, "Sixty days old" );
+sendmail( $hash{UID}, $notsixty, "Less than sixty days old" );
+sendmail( $hash{UID}, $d365, "365 days old" );
+sendmail( $hash{UID}, $notd365, "Less than 365 days old" );
+
+populate_trash( "Trash/Incinerator", $hash{UID}, $seven, 7 );
+populate_trash( "Trash", $hash{UID}, $six, 6 );
+populate_trash( "Sent", $hash{UID}, $thirty, 30 );
+populate_trash( "Sent", $hash{UID}, $notthirty, 29 );
+
+movemail( "365 days old", "365_folder" );
+
+movemail( "Less than 365 days old", "not_365_folder" );
+
+exit;
+
+sub seconds {
+ my $d = shift or return undef;
+ my ( $yy, $moy, $dom, $hr, $min ) =
+ $d =~ m! ^ # anchor at start #
+ (\d\d\d\d) # year #
+ (\d\d) # month #
+ (\d\d) # day #
+ (\d\d) # hour #
+ (\d\d) # minute #
+ !x;
+
+ # allow year 0999 to be year 999, and year 0099 to be year 99
+ return timegm( 0, $min, $hr, $dom, $moy - 1,
+ ( $yy > 999 ? $yy : $yy - 1900 ) );
+}
+
+sub sendmail {
+ my ( $to, $date, $subject ) = @_;
+ my $text = <<EOTEXT ;
+To: $to\@$hash{DOMAIN}
Date: @{[&rfc822_date($date)]}
Subject: $subject
Dear mail tester,
-This is a test message to test mail for messages \l$subject.
+This is a test message to test mail for messages \l$subject.
I hope you like it!
@@ -125,117 +126,105 @@
The E-Mail Engineering Team
EOTEXT
- #
- for (my $x = 0; $x < 10 ; $x ++ ) {
- my $imap = Mail::IMAPClient->new (
- Server => $hash{HOST} ,
- User => $hash{UID} ,
- Password=> $hash{PSWD} )
- or die "can't connect: $!\n" ;
- #
- $imap->append("INBOX",$text) ;
- $imap->logout ;
- }
- }
- #
-sub populate_trash {
- my $where = shift ;
- my $to = shift ;
- my $date = shift ;
- my $d = shift ;
- #
- my($ss,$min,$hr,$day,$mon,$year)=gmtime($date) ;
- $mon++ ;
- $year += 1900 ;
- my $fn =sprintf("%4.4d%2.2d%2.2d%2.2d%2.2d%2.2d" ,
- $year,$mon,$day,$hr,$min,$ss ) ;
- my $x = 0 ;
- my $subject = "$where -- $d days old" ;
- while ($x++ < 10) {
- my $fh ;
- $fh .= "Date: @{[&rfc822_date($date)]}\n" ;
- $fh .= <<EOTRAH ;
+
+ for ( my $x = 0 ; $x < 10 ; $x++ ) {
+ my $imap = Mail::IMAPClient->new(
+ Server => $hash{HOST},
+ User => $hash{UID},
+ Password => $hash{PSWD}
+ ) or die "can't connect: $!\n";
+
+ $imap->append( "INBOX", $text );
+ $imap->logout;
+ }
+}
+
+sub populate_trash {
+ my $where = shift;
+ my $to = shift;
+ my $date = shift;
+ my $d = shift;
+
+ my ( $ss, $min, $hr, $day, $mon, $year ) = gmtime($date);
+ $mon++;
+ $year += 1900;
+ my $fn = sprintf( "%4.4d%2.2d%2.2d%2.2d%2.2d%2.2d",
+ $year, $mon, $day, $hr, $min, $ss );
+ my $x = 0;
+ my $subject = "$where -- $d days old";
+ while ( $x++ < 10 ) {
+ my $fh;
+ $fh .= "Date: @{[&rfc822_date($date)]}\n";
+ $fh .= <<EOTRAH ;
Subject: $subject
This note was put in the $where folder $d days ago. (My how time flies!)
I hope you enjoyed testing with it!
EOTRAH
- my $imap = Mail::IMAPClient->new (
- Server => $hash{HOST} ,
- User => $hash{UID} ,
- Password=> $hash{PSWD} )
- or die "can't connect: $!\n" ;
- $imap->append($where, $fh) ;
- #
- }
- #
- }
- #
-sub movemail {
- #
- my ($subj,$fold) = @_ ;
- my $fh = Mail::IMAPClient->new (
- Debug => 0 ,
- Server => $hash{HOST}
,
- User => $hash{UID} ,
- Password => $hash{PSWD}
,
- )
- ;
- #
- $fh->select("inbox") or die "cannot open inbox: $!\n" ;
- #
- foreach my $f ($fh->search(qq(SUBJECT "$subj")) ) {
- #
- $fh->move($fold,$f) ;
- #
- }
- #
- }
- #
-sub clean_mailbox {
- #
- my $fh =Mail::IMAPClient->new (
- Debug => 0 ,
- Server => $hash{HOST}
,
- User => $hash{UID} ,
- Password => $hash{PSWD}
,
- )
- ;
- for my $x (@{$hash{FOLDERS}}) {
- my @msgs ;
- $fh->create($x) unless $fh->exists($x) ;
- $fh->select($x) ;
- for my $s (@{$hash{SUBJECTS}}) {
- push @msgs, $fh->search(qq(SUBJECT "$s")) ;
- }
- $fh->delete_message(@msgs) if scalar(@msgs) ;
- $fh->expunge ;
- }
- }
- #
-sub rfc822_date
{
-#Date: Fri, 09 Jul 1999 13:10:55 -0400 #
-my $date = shift ;
-my @date = localtime($date) ;
-my @dow = qw{ Sun Mon Tue Wed Thu Fri Sat } ;
-my @mnt = qw{ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec} ;
- #
-return sprintf
(
- "%s, %2.2d %s %4.4s %2.2d:%2.2d:%2.2d -0400" ,
- $dow[$date[6]] ,
- $date[3] ,
- $mnt[$date[4]] ,
- $date[5]+=1900 ,
- $date[2] ,
- $date[1] ,
- $date[0] )
- ;
- }
+ my $imap = Mail::IMAPClient->new(
+ Server => $hash{HOST},
+ User => $hash{UID},
+ Password => $hash{PSWD}
+ ) or die "can't connect: $!\n";
+ $imap->append( $where, $fh );
+ }
+}
+
+sub movemail {
+ my ( $subj, $fold ) = @_;
+ my $fh = Mail::IMAPClient->new(
+ Debug => 0,
+ Server => $hash{HOST},
+ User => $hash{UID},
+ Password => $hash{PSWD},
+ );
+
+ $fh->select("inbox") or die "cannot open inbox: $!\n";
+
+ foreach my $f ( $fh->search(qq(SUBJECT "$subj")) ) {
+ $fh->move( $fold, $f );
+ }
+}
+
+sub clean_mailbox {
+ my $fh = Mail::IMAPClient->new(
+ Debug => 0,
+ Server => $hash{HOST},
+ User => $hash{UID},
+ Password => $hash{PSWD},
+ );
+ for my $x ( @{ $hash{FOLDERS} } ) {
+ my @msgs;
+ $fh->create($x) unless $fh->exists($x);
+ $fh->select($x);
+ for my $s ( @{ $hash{SUBJECTS} } ) {
+ push @msgs, $fh->search(qq(SUBJECT "$s"));
+ }
+ $fh->delete_message(@msgs) if scalar(@msgs);
+ $fh->expunge;
+ }
+}
+
+# Date: Fri, 09 Jul 1999 13:10:55 -0400
+sub rfc822_date {
+ my $date = shift;
+ my @date = localtime($date);
+ my @dow = qw{ Sun Mon Tue Wed Thu Fri Sat };
+ my @mnt = qw{ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec};
+
+ return sprintf(
+ "%s, %2.2d %s %4.4s %2.2d:%2.2d:%2.2d -0400",
+ $dow[ $date[6] ],
+ $date[3],
+ $mnt[ $date[4] ],
+ $date[5] += 1900,
+ $date[2], $date[1], $date[0]
+ );
+}
+=head1 AUTHOR
-=head1 AUTHOR
-
David J. Kernen
The Kernen Group, Inc.
@@ -244,76 +233,14 @@
=head1 COPYRIGHT
-This example and Mail::IMAPClient are Copyright (c) 2003
+This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
-This example is distributed with Mail::IMAPClient and
+This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
-imtest is a utility distributed with Cyrus IMAP server,
-Copyright (c) 1994-2000 Carnegie Mellon University.
-All rights reserved.
+imtest is a utility distributed with Cyrus IMAP server,
+Copyright (c) 1994-2000 Carnegie Mellon University.
+All rights reserved.
=cut
-
-# $Id$
-# $Log: populate_mailbox.pl,v $
-# Revision 19991216.8 2003/06/12 21:38:34 dkernen
-#
-# Preparing 2.2.8
-# Added Files: COPYRIGHT
-# Modified Files: Parse.grammar
-# Added Files: Makefile.old
-# Makefile.PL Todo sample.perldb
-# BodyStructure.pm
-# Parse.grammar Parse.pod
-# range.t
-# Thread.grammar
-# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
-# rfc2221.txt rfc2359.txt rfc2683.txt
-#
-# Revision 1.1 2003/06/12 21:38:16 dkernen
-#
-# Preparing 2.2.8
-# Added Files: COPYRIGHT
-# Modified Files: Parse.grammar
-# Added Files: Makefile.old
-# Makefile.PL Todo sample.perldb
-# BodyStructure.pm
-# Parse.grammar Parse.pod
-# range.t
-# Thread.grammar
-# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
-# rfc2221.txt rfc2359.txt rfc2683.txt
-#
-# Revision 19991216.7 2002/08/23 13:29:49 dkernen
-#
-# Modified Files: Changes IMAPClient.pm INSTALL MANIFEST Makefile Makefile.PL
README Todo test.txt
-# Made changes to create version 2.1.6.
-# Modified Files:
-# imap_to_mbox.pl populate_mailbox.pl
-# Added Files:
-# cleanTest.pl migrate_mbox.pl
-#
-# Revision 19991216.6 2000/12/11 21:58:53 dkernen
-#
-# Modified Files:
-# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl
-# imap_to_mbox.pl populate_mailbox.pl
-# to add CVS data
-#
-# Revision 19991216.5 1999/12/16 17:19:15 dkernen
-# Bring up to same level
-#
-# Revision 19991124.3 1999/12/16 17:14:26 dkernen
-# Incorporate changes for exists method performance enhancement
-#
-# Revision 19991124.02 1999/11/24 17:46:21 dkernen
-# More fixes to t/basic.t
-#
-# Revision 19991124.01 1999/11/24 16:51:51 dkernen
-# Changed t/basic.t to test for UIDPLUS before trying UID cmds
-#
-# Revision 1.4 1999/11/23 17:51:06 dkernen
-# Committing version 1.06 distribution copy
-#
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Mail-IMAPClient-3.37/lib/Mail/IMAPClient.pm
new/Mail-IMAPClient-3.40/lib/Mail/IMAPClient.pm
--- old/Mail-IMAPClient-3.37/lib/Mail/IMAPClient.pm 2015-08-14
19:23:31.000000000 +0200
+++ new/Mail-IMAPClient-3.40/lib/Mail/IMAPClient.pm 2018-12-06
02:45:45.000000000 +0100
@@ -7,7 +7,7 @@
use warnings;
package Mail::IMAPClient;
-our $VERSION = '3.37';
+our $VERSION = '3.40';
use Mail::IMAPClient::MessageSet;
@@ -47,6 +47,7 @@
my %Load_Module = (
"Compress-Zlib" => "Compress::Zlib",
"INET" => "IO::Socket::INET",
+ "IP" => "IO::Socket::IP",
"SSL" => "IO::Socket::SSL",
"UNIX" => "IO::Socket::UNIX",
"BodyStructure" => "Mail::IMAPClient::BodyStructure",
@@ -346,13 +347,14 @@
Proto => "tcp",
);
- # extra control of SSL args is supported
+ # pass SSL args if requested; default to IO::Socket::(IP|INET)
if ( $self->Ssl ) {
$ioclass = $self->_load_module("SSL");
push( @sockargs, @{ $self->Ssl } ) if ref $self->Ssl eq "ARRAY";
}
else {
- $ioclass = $self->_load_module("INET");
+ $ioclass = $self->_load_module("IP");
+ $ioclass = $self->_load_module("INET") unless $ioclass;
}
}
@@ -366,7 +368,11 @@
return $self->Socket($sock);
}
else {
- my $lasterr = $self->LastError || "";
+ my $lasterr = $self->LastError;
+ if ( !$lasterr and $self->Ssl and $ioclass ) {
+ $lasterr = $ioclass->errstr;
+ }
+ $lasterr ||= "";
$self->LastError("Unable to connect to $server: $lasterr");
return undef;
}
@@ -571,13 +577,14 @@
# if user is passed as a literal:
# 1. send passwd as a literal
# 2. empty literal passwd are sent as an blank line ($CRLF)
- $user = ( $user eq "" ) ? qq("") : $self->Quote($user);
+ $user = $self->Quote($user);
if ( $user =~ /^{/ ) {
+ my $nopasswd = ( $passwd eq "" ) ? 1 : 0;
$passwd = $self->Quote( $passwd, 1 ); # force literal
- $passwd .= $CRLF if ( $passwd eq "{0}$CRLF" ); # blank line
+ $passwd .= $CRLF if ($nopasswd); # blank line
}
else {
- $passwd = qq("") if ( $passwd eq "" );
+ $passwd = $self->Quote($passwd);
}
$self->_imap_command("LOGIN $user $passwd")
@@ -598,7 +605,7 @@
sub proxyauth {
my ( $self, $user ) = @_;
- $user = ( $user eq "" ) ? qq("") : $self->Quote($user);
+ $user = $self->Quote($user);
$self->_imap_command("PROXYAUTH $user") ? $self->Results : undef;
}
@@ -764,7 +771,7 @@
sub deleteacl {
my ( $self, $target, $user ) = @_;
$target = $self->Quote($target);
- $user = ( $user eq "" ) ? qq("") : $self->Quote($user);
+ $user = $self->Quote($user);
$self->_imap_command(qq(DELETEACL $target $user))
or return undef;
@@ -778,8 +785,8 @@
$target = $self->Quote($target);
$user ||= $self->User;
- $user = ( $user eq "" ) ? qq("") : $self->Quote($user);
- $acl = ( $acl eq "" ) ? qq("") : $self->Quote($acl);
+ $user = $self->Quote($user);
+ $acl = $self->Quote($acl);
$self->_imap_command(qq(SETACL $target $user $acl))
or return undef;
@@ -823,7 +830,7 @@
$target = $self->Quote($target);
$user ||= $self->User;
- $user = ( $user eq "" ) ? qq("") : $self->Quote($user);
+ $user = $self->Quote($user);
$self->_imap_command(qq(LISTRIGHTS $target $user))
or return undef;
@@ -1164,7 +1171,8 @@
my $count = shift || $self->Count;
# DONE looks like a tag when sent and not already in IDLE
- $self->_imap_command( { addtag => 0, tag => qr/(?:$count|DONE)/ }, "DONE" )
+ $self->_imap_command(
+ { addtag => 0, tag => qr/(?:$count|DONE)/, doretry => 0 }, "DONE" )
or return undef;
return $self->Results;
}
@@ -1210,8 +1218,11 @@
}
# wrapper for _imap_command_do to enable retrying on lost connections
+# options:
+# doretry => 0|1 - suppress|allow retry after reconnect
sub _imap_command {
my $self = shift;
+ my $opt = ref( $_[0] ) eq "HASH" ? $_[0] : {};
my $tries = 0;
my $retry = $self->Reconnectretry || 0;
@@ -1240,6 +1251,7 @@
my $ret = $self->reconnect;
if ($ret) {
$self->_debug("reconnect success($ret) on try #$tries/$retry");
+ last if exists $opt->{doretry} and !$opt->{doretry};
}
elsif ( defined $ret and $ret == 0 ) { # escaping recursion
return undef;
@@ -1465,6 +1477,44 @@
push @{ $self->{History}{$count} }, $array;
}
+# try to avoid exposing auth info via debug unless Showcredentials is true
+sub _redact_line {
+ my ( $self, $string ) = @_;
+ $self->Showcredentials and return undef;
+
+ my ( $tag, $cmd ) = ( $self->Count, undef );
+ my $retext = "[Redact: Count=$tag Showcredentials=OFF]";
+ my $show = $retext;
+
+ # tagged command?
+ if ( $string =~ s/^($tag\s+(\S+)\s+)// ) {
+ ( $show, $cmd ) = ( $1, $2 );
+
+ # login <username|literal> <password|literal>
+ if ( $cmd =~ /login/i ) {
+
+ # username as literal
+ if ( $string =~ /^{/ ) {
+ $show .= $string;
+ }
+
+ # username (possibly quoted) string, then literal? password
+ elsif ( $string =~ s/^((?:"(?>(?:(?>[^"\\]+)|\\.)*)"|\S+)\s*)// ) {
+ $show .= $1;
+ $show .= ( $string =~ /^{/ ) ? $string : $retext;
+ }
+ }
+ elsif ( $cmd =~ /^auth/i ) {
+ $show .= $string;
+ }
+ else {
+ return undef; # show it all
+ }
+ }
+
+ return $show;
+}
+
# _send_line handles literal data and supports the Prewritemethod
sub _send_line {
my ( $self, $string, $suppress ) = @_;
@@ -1475,7 +1525,13 @@
# handle case where string contains a literal
if ( $string =~ s/^([^$LF\{]*\{\d+\}$CRLF)(?=.)//o ) {
my $first = $1;
- $self->_debug("Sending literal: $first\tthen: $string");
+ if ( $self->Debug ) {
+ my $dat =
+ ( $self->IsConnected and !$self->IsAuthenticated )
+ ? $self->_redact_line($string)
+ : undef;
+ $self->_debug( "Sending literal: $first\tthen: ", $dat || $string
);
+ }
$self->_send_line($first) or return undef;
# look for "$tag NO" or "+ ..."
@@ -1488,7 +1544,14 @@
$string = $prew->( $self, $string );
}
- $self->_debug("Sending: $string");
+ if ( $self->Debug ) {
+ my $dat =
+ ( $self->IsConnected and !$self->IsAuthenticated )
+ ? $self->_redact_line($string)
+ : undef;
+ $self->_debug( "Sending: ", $dat || $string );
+ }
+
unless ( $self->IsConnected ) {
$self->LastError("NO not connected");
return undef;
@@ -2198,7 +2261,9 @@
$l = shift @$output;
next ATTR;
}
- elsif ( $l=~
m/\G(?:"((?>(?:(?>[^"\\]+)|\\.)*))"|([^()\s]+))\s*/gc ) {
+ elsif (
+ $l =~ m/\G(?:"((?>(?:(?>[^"\\]+)|\\.)*))"|([^()\s]+))\s*/gc )
+ {
$value = defined $1 ? $1 : $2;
$entry->{$key} = $value;
next ATTR;
@@ -2206,7 +2271,9 @@
elsif ( $l =~ m/\G\(/gc ) {
my $depth = 1;
$value = "";
- while ( $l =~
m/\G("((?>(?:(?>[^"\\]+)|\\.)*))"\s*|[()]|[^()"]+)/gc ) {
+ while ( $l =~
+ m/\G("((?>(?:(?>[^"\\]+)|\\.)*))"\s*|[()]|[^()"]+)/gc )
+ {
my $stuff = $1;
if ( $stuff eq "(" ) {
$depth++;
@@ -2241,9 +2308,15 @@
# NOTE: old code tried to remove any "unrequested" data in $entry
# - UID is sometimes not explicitly requested, are there others?
+ # - rt#115726: Uid and $entry->{UID} not set, ignore unsolicited data
if ( $self->Uid ) {
- $uids->{ $entry->{UID} } = $entry;
- delete $entry->{UID} unless $asked_for_uid;
+ if ( $entry->{UID} ) {
+ $uids->{ $entry->{UID} } = $entry;
+ delete $entry->{UID} unless $asked_for_uid;
+ }
+ else {
+ $self->_debug("ignoring unsolicited response: $l");
+ }
}
else {
$uids->{$mid} = $entry;
@@ -2317,6 +2390,10 @@
my ( $self, $msgspec ) = ( shift, shift );
return undef unless $self->has_capability("UIDPLUS");
+ unless ( $self->Uid ) {
+ $self->LastError("Uid must be enabled for uidexpunge");
+ return undef;
+ }
my $msg =
UNIVERSAL::isa( $msgspec, 'Mail::IMAPClient::MessageSet' )
@@ -2325,23 +2402,35 @@
$msg->cat(@_) if @_;
- if ( $self->Uid ) {
- $self->_imap_command("UID EXPUNGE $msg")
+ my ( @data, $cmd );
+ my ($seq_set) = $self->_split_sequence( $msg, "UID EXPUNGE" );
+
+ for ( my $x = 0 ; $x <= $#$seq_set ; $x++ ) {
+ my $seq = $seq_set->[$x];
+ $self->_imap_uid_command( "EXPUNGE" => $seq )
or return undef;
+ my $res = $self->Results;
+
+ # only keep last command and last response (* OK ...)
+ $cmd = shift(@$res);
+ pop(@$res) if ( $x != $#{$seq_set} );
+ push( @data, @$res );
}
- else {
- $self->LastError("Uid must be enabled for uidexpunge");
- return undef;
+
+ if ( $cmd and !wantarray ) {
+ $cmd =~ s/^(\d+\s+.*?EXPUNGE\s+)\S+(\s*)/$1$msg$2/;
+ unshift( @data, $cmd );
}
- return wantarray ? $self->History : $self->Results;
+ #wantarray ? $self->History : $self->Results;
+ return wantarray ? @data : \@data;
}
sub rename {
my ( $self, $from, $to ) = @_;
- $from = ( $from eq "" ) ? qq("") : $self->Quote($from);
- $to = ( $to eq "" ) ? qq("") : $self->Quote($to);
+ $from = $self->Quote($from);
+ $to = $self->Quote($to);
$self->_imap_command(qq(RENAME $from $to)) ? $self : undef;
}
@@ -2392,13 +2481,13 @@
}
}
- # Or did he want a hash from msgid to flag array?
+ # Return a hash from msgid to flag array?
return $flagset
if ref $msgspec;
- # or did the guy want just one response? Return it if so
+ # Or, just one response? Return it if so
my $flagsref = $flagset->{$msgspec};
- return wantarray ? @$flagsref : $flagsref;
+ return wantarray ? @{ $flagsref || [] } : $flagsref;
}
# reduce a list, stripping undeclared flags. Flags with or without
@@ -2833,13 +2922,13 @@
my $rec = $self->_list_or_lsub_response_parse($resp);
next unless defined $rec->{attrs};
$self->_debug("unexpected attrs data: @$list\n") if $attrs;
- $attrs = $rec->{attrs}->[0];
+ $attrs = $rec->{attrs};
}
if ($attrs) {
- return undef if $attrs =~ /\\NoInferiors/i;
- return 1 if $attrs =~ /\\HasChildren/i;
- return 0 if $attrs =~ /\\HasNoChildren/i;
+ return undef if grep { /\A\\NoInferiors\Z/i } @$attrs;
+ return 1 if grep { /\A\\HasChildren\Z/i } @$attrs;
+ return 0 if grep { /\A\\HasNoChildren\Z/i } @$attrs;
}
else {
$self->_debug( join( "\n\t", "no attrs for '$folder' in:", @$list ) );
@@ -3318,21 +3407,21 @@
sub getquotaroot {
my ( $self, $what ) = @_;
- my $who = $what ? $self->Quote($what) : "INBOX";
+ my $who = defined $what ? $self->Quote($what) : "INBOX";
return $self->_imap_command("GETQUOTAROOT $who") ? $self->Results : undef;
}
# BUG? using user/$User here and INBOX in quota/quota_usage
sub getquota {
my ( $self, $what ) = @_;
- my $who = $what ? $self->Quote($what) : "user/" . $self->User;
+ my $who = defined $what ? $self->Quote($what) : "user/" . $self->User;
return $self->_imap_command("GETQUOTA $who") ? $self->Results : undef;
}
# usage: $self->setquota($quotaroot, storage => 512, ...)
sub setquota(@) {
my ( $self, $what ) = ( shift, shift );
- my $who = $what ? $self->Quote($what) : "user/" . $self->User;
+ my $who = defined $what ? $self->Quote($what) : "user/" . $self->User;
my @limits;
while (@_) {
my ( $k, $v ) = ( $self->Quote( uc( shift @_ ) ), shift @_ );
@@ -3371,7 +3460,7 @@
if ( $force or $name =~ /["\\[:^ascii:][:cntrl:]]/s ) {
return "{" . length($name) . "}" . $CRLF . $name;
}
- elsif ( $name =~ /[(){}\s%*\[\]]/s ) {
+ elsif ( $name =~ /[(){}\s%*\[\]]/s or $name eq "" ) {
return qq("$name");
}
else {
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Mail-IMAPClient-3.37/lib/Mail/IMAPClient.pod
new/Mail-IMAPClient-3.40/lib/Mail/IMAPClient.pod
--- old/Mail-IMAPClient-3.37/lib/Mail/IMAPClient.pod 2015-08-14
19:23:31.000000000 +0200
+++ new/Mail-IMAPClient-3.40/lib/Mail/IMAPClient.pod 2018-09-27
02:46:52.000000000 +0200
@@ -1196,17 +1196,18 @@
{
name => 'Mail/Box/Name',
- attrs => '\Marked \HasNoChildren',
+ attrs => [ '\Marked', '\HasNoChildren' ],
delim => '/',
}
IMAP servers implementing RFC6154 return attributes to be used to
identify special-use mailboxes (folders).
- my $sattr_re = /\b\\(?:All|Archive|Drafts|Flagged|Junk|Sent|Trash)\b/;
+ my $sattr_re = /\A\\(?:All|Archive|Drafts|Flagged|Junk|Sent|Trash)\Z/;
foreach my $fhash (@fhashes) {
- next unless ( $fhash->{attrs} =~ $sattr_re );
- print("special: $fhash->{name} : $fhash->{attrs}\n");
+ next unless defined $fhash->{name};
+ my @special = grep { $sattr_re } @{ $fhash->{attrs} };
+ print("special: $fhash->{name} : @special\n") if (@special);
}
Version note: method added in Mail::IMAPClient 3.34
@@ -2115,9 +2116,24 @@
case of an error. The B<recent_count> method was contributed by Rob
Deker ([email protected]).
+=head2 noop
+
+Example:
+
+ $imap->noop or die "noop failed: $@\n";
+
+The B<noop> method performs an IMAP NOOP command. Per RFC3501 this
+command does nothing and always succeeds. However, if a connection
+times out or other errors occur while communicating with the server,
+this method can still fail. This command can be used as a periodic
+poll to check for (untagged) status updates (new messages, etc.) from
+the server and also to reset any inactivity/auto-logout timers the
+server may maintain.
+
=head2 reconnect
Example:
+
$imap->noop or $imap->reconnect or die "noop failed: $@\n";
Attempt to reconnect if the IMAP connection unless $imap is already in
@@ -3463,9 +3479,9 @@
sure that C<$ssl> in the example is a valid and connected socket.
This method is primarily used to provide a drop-in replacement for
-L<IO::Socket::INET>, used by L</connect> by default. In fact, this
+IO::Socket::(INET|IP), used by L</connect> by default. In fact, this
method is called by L</connect> itself after having established a
-suitable L<IO::Socket::INET> socket connection towards the target
+suitable IO::Socket::(INET|IP) socket connection towards the target
server; for this reason, this method also carries the normal
operations associated with L</connect>, namely:
@@ -3517,8 +3533,8 @@
=head2 Socketargs
-The arguments used in the call to IO::Socket::{UNIX|INET|SSL}->new can
-be controlled by setting this attribute to an ARRAY reference
+The arguments used in the call to IO::Socket::{UNIX|INET|IP|SSL}->new
+can be controlled by setting this attribute to an ARRAY reference
containing the desired arguments.
For example, to always pass MultiHomed => 1 to IO::Socket::...->new
@@ -3536,7 +3552,7 @@
If an IMAP connection requires SSL you can set the Ssl attribute to
'1' and Mail::IMAPClient will automatically use L<IO::Socket::SSL>
-instead of L<IO::Socket::INET> to connect to the server. This
+instead of IO::Socket::(INET|IP) to connect to the server. This
attribute is used in the L</connect> method. The arguments used in
the call to IO::Socket::SSL->new can be controlled by setting this
attribute to an ARRAY reference containing the desired arguments.
@@ -3880,7 +3896,7 @@
authentication technique you may choose to set up your own socket
connection and then set this parameter manually, bypassing the
B<connect> method completely. This is also useful if you want to use
-L<IO::Socket::INET> alternatives like L<IO::Socket::SSL> and need full
+IO::Socket::(INET|IP) alternatives like IO::Socket::SSL and need full
control.
L</RawSocket> simply gets/sets the socket without attempting any
@@ -3968,7 +3984,7 @@
Copyright (C) 1999-2003 The Kernen Group, Inc.
Copyright (C) 2007-2009 Mark Overmeer
- Copyright (C) 2010-2015 Phil Pearl (Lobbes)
+ Copyright (C) 2010-2017 Phil Pearl (Lobbes)
All rights reserved.
This library is free software; you can redistribute it and/or modify
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Mail-IMAPClient-3.37/t/basic.t
new/Mail-IMAPClient-3.40/t/basic.t
--- old/Mail-IMAPClient-3.37/t/basic.t 2015-08-14 19:23:31.000000000 +0200
+++ new/Mail-IMAPClient-3.40/t/basic.t 2018-10-05 06:51:27.000000000 +0200
@@ -6,52 +6,31 @@
use Test::More;
use File::Temp qw(tempfile);
-my $debug = $ARGV[0];
-
-my %parms;
-my $range = 0;
-my $uidplus = 0;
-my $fast = 1;
+use lib "t/lib";
+use MyTest;
+my $params;
BEGIN {
- open TST, 'test.txt'
- or plan skip_all => 'test parameters not provided in test.txt';
-
- while ( my $l = <TST> ) {
- chomp $l;
- my ( $p, $v ) = split /\=/, $l, 2;
- s/^\s+//, s/\s+$// for $p, $v;
- $parms{$p} = $v if $v;
- }
-
- close TST;
-
- my @missing;
- foreach my $p (qw/server user passed/) {
- push( @missing, $p ) unless defined $parms{$p};
- }
-
- @missing
- ? plan skip_all => "missing value for: @missing"
- : plan tests => 104;
+ eval { $params = MyTest->new; };
+ $@
+ ? plan skip_all => $@
+ : plan tests => 107;
}
BEGIN { use_ok('Mail::IMAPClient') or exit; }
+my $debug = $ARGV[0];
+my $range = 0;
+my $uidplus = 0;
+
my %new_args = (
- Server => delete $parms{server},
- Port => delete $parms{port},
- User => delete $parms{user},
- Password => delete $parms{passed},
- Authmechanism => delete $parms{authmech},
Clear => 0,
- Fast_IO => $fast,
Uid => $uidplus,
Debug => $debug,
);
# allow other options to be placed in test.txt
-%new_args = ( %new_args, %parms );
+%new_args = ( %new_args, %${params} );
my $imap = Mail::IMAPClient->new(
%new_args,
@@ -66,6 +45,11 @@
isa_ok( $imap, 'Mail::IMAPClient' );
+{
+ my $type = ref $imap->Socket;
+ ok( $type =~ /^IO::Socket::.*/, "Socket ref is $type" );
+}
+
$imap->Debug_fh->autoflush() if $imap->Debug_fh;
my $testmsg = <<__TEST_MSG;
@@ -113,7 +97,7 @@
[ sort keys %{ $fh[0] } ],
[ sort @fh_keys ],
"folders eq folders_hash"
- )
+ );
}
# test append_file
@@ -190,6 +174,17 @@
ok( $imap->delete_message($uid), "delete_message $uid" );
ok( $imap->uidexpunge($uid), "uidexpunge $uid" );
+=begin comment
+
+ my $ol = $imap->Maxcommandlength();
+ $imap->Maxcommandlength(64);
+ my $exp = $imap->uidexpunge($uid . "," . join(",", map{$_*2} 2..40) );
+ $imap->Maxcommandlength($ol);
+ is( $exp->[0], $imap->Count . " UID EXPUNGE $uid", "UID EXPUNGE $uid" );
+ is( grep( /^\* $uid EXPUNGE/, @$exp ), !undef, "found EXPUNGE response" );
+
+=cut
+
# multiple args joined internally in append()
$uid = $imap->append( $target, $testmsg, "Some extra text too" );
ok( defined $uid, "append test message to $target with date (uid=$uid)" );
@@ -461,6 +456,14 @@
$imap->delete($target);
}
+{
+ $imap->select('inbox');
+ my $bogusf = $imap->flags(42);
+ is( $bogusf, undef, '(scalar) flags returns undef for bogus message' );
+ my @bogusf = $imap->flags(42);
+ is( $bogusf[0], undef, '(list) flags returns array with undef element 0
for bogus message' );
+}
+
$imap->_disconnect;
ok( $imap->reconnect, "reconnect" );
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Mail-IMAPClient-3.37/t/lib/MyTest.pm
new/Mail-IMAPClient-3.40/t/lib/MyTest.pm
--- old/Mail-IMAPClient-3.37/t/lib/MyTest.pm 1970-01-01 01:00:00.000000000
+0100
+++ new/Mail-IMAPClient-3.40/t/lib/MyTest.pm 2016-01-04 20:14:50.000000000
+0100
@@ -0,0 +1,35 @@
+package MyTest;
+
+use strict;
+use warnings;
+
+my $infile = "test.txt";
+
+sub new {
+ my ($class) = @_;
+ my %self;
+
+ open( my $fh, "<", $infile )
+ or die("test parameters not provided in $infile\n");
+
+ my %argmap = ( passed => "Password", authmech => "Authmechanism" );
+ while ( my $l = <$fh> ) {
+ chomp $l;
+ next if $l =~ /^\s*#/;
+ my ( $p, $v ) = split( /=/, $l, 2 );
+ s/^\s+//, s/\s+$// for $p, $v;
+ $p = $argmap{$p} if $argmap{$p};
+ $self{ ucfirst($p) } = $v if defined $v;
+ }
+ close($fh);
+
+ my @missing;
+ foreach my $p (qw/Server User Password/) {
+ push( @missing, $p ) unless defined $self{$p};
+ }
+
+ die("missing value for: @missing") if (@missing);
+ return \%self;
+}
+
+1;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Mail-IMAPClient-3.37/t/quota.t
new/Mail-IMAPClient-3.40/t/quota.t
--- old/Mail-IMAPClient-3.37/t/quota.t 1970-01-01 01:00:00.000000000 +0100
+++ new/Mail-IMAPClient-3.40/t/quota.t 2018-09-27 01:14:55.000000000 +0200
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+
+use lib "t/lib";
+use MyTest;
+my $params;
+
+BEGIN {
+ eval { $params = MyTest->new; };
+ $@
+ ? plan skip_all => $@
+ : plan tests => 7;
+}
+
+BEGIN { use_ok('Mail::IMAPClient') or exit; }
+
+my %args = ( Debug => $ARGV[0], %$params );
+my $imap = Mail::IMAPClient->new(%args);
+ok( !$@, "successful login" ) or diag( '$@:' . $@ );
+
+# RFC 2087: QUOTA
+SKIP: {
+ my ( $res, $root );
+ skip "QUOTA not supported", 5 unless $imap->has_capability("QUOTA");
+
+ foreach my $root ( "", "INBOX", "/blah" ) {
+ $res = $imap->getquotaroot($root);
+ ok( $res, "getquotaroot($root)" ) or diag( '$@:' . $@ );
+
+ #my $tag = $imap->Count;
+ #foreach my $r ( @{$res||[]} ) {
+ # next if $r =~ /^$tag\s+/;
+ # chomp($r);
+ # warn("gqr r=$r\n");
+ #}
+ }
+
+ ok( $imap->getquota("User quota"), "getquota" ) or diag( '$@:' . $@ );
+
+ my $dne = "ThisDoesNotExist";
+ ok( !$imap->getquota($dne), "getquota($dne)" ) or diag( '$@:' . $@ );
+}
++++++ cpanspec.yml ++++++
--- /var/tmp/diff_new_pack.fedhSs/_old 2019-01-28 20:49:50.245817062 +0100
+++ /var/tmp/diff_new_pack.fedhSs/_new 2019-01-28 20:49:50.245817062 +0100
@@ -9,7 +9,11 @@
# bar.patch:
#preamble: |-
# BuildRequires: gcc-c++
-#post_prep: |-
+post_prep: |-
+ for f in examples/*.pl
+ do
+ sed -i 's|^#!/usr/local/bin/perl|%{__perl}|' ${f}
+ done
# hunspell=`pkg-config --libs hunspell | sed -e 's,-l,,; s, *,,g'`
# sed -i -e "s,hunspell-X,$hunspell," t/00-prereq.t Makefile.PL
#post_install: |-
