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 <aloi...@gmx.com> + +- Fixed shebangs in example scripts + +------------------------------------------------------------------- +Thu Dec 6 15:51:38 UTC 2018 - Stephan Kulow <co...@suse.com> + +- 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) <p...@zimbra.com>" + "Phil Pearl (Lobbes) <plobbes+mail-imapcli...@gmail.com>" ], "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) <p...@zimbra.com>' + - 'Phil Pearl (Lobbes) <plobbes+mail-imapcli...@gmail.com>' 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) <p...@zimbra.com>', + AUTHOR => 'Phil Pearl (Lobbes) <plobbes+mail-imapcli...@gmail.com>', 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 (de...@ikimbo.com). +=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: |-