Net-IMAP-Simple-1.2209/ 0000750 0001750 0001750 00000000000 13117505001 014206 5 ustar jettero jettero Net-IMAP-Simple-1.2209/Changes 0000644 0001750 0001750 00000052652 13117223422 015524 0 ustar jettero jettero 1.2209: Thu Jun 08 2017
- made SimpleX not optional
- made testing work against dovecot again
- move a bunch of things to the lib/ dirs (I don't really get why this is a thing, but whatever)
- add put_with_date() from billhess
1.2207: Sat Oct 01 2016
- repair unit tests to work with gmail (pfft)
- added in pull requests on github
the only non-doc item was https://github.com/jettero/net--imap--simple/pull/6
1.2206: Thu Dec 18 2014
- minor debug issue
1.2205: Sat May 17 2014
- Patch from Rob Hoelz to fix bug/docbug regarding port numbers.
1.2204: Sat Dec 14 2013
- disable error checking on expunge. It's not clear to me
that this ever produces an error (which would be with the
delete or select commands, not expunge).
1.2203: Mon Oct 07 2013
- https://rt.cpan.org/Public/Bug/Display.html?id=89296
I think I fixed a design problem (no argument sanitization)
thinking it fixed the bug, but there may have never been a
bug.
- nope, was a format problem. Holborn supplied his own
patches.
1.2202: Wed Oct 02 2013
- really minor pod fix
https://rt.cpan.org/Public/Bug/Display.html?id=89195
1.2201: Mon Aug 05 2013
- stupid bug in the new ssl defaults code, fixed by
ChinaXing(陈云星) — how do I miss this stuff?
1.2200: Wed Apr 07 2013
- SSL evolved on me. They actually expect me to check certs?
Madness. I came up with some reasonable defaults and some
settings and things. The final solution to the defaults
puzzle was an amalgam of various ideas from Tom Heady
(https://github.com/tomheady).
- I deleted the Net::IMAP::Server from inc/ and there is no
longer a Net::IMAP::Server environment to test in. It was
driving me crazy how buggy that was in some places, and I
had no ability to reproduce those environments, so I removed
it. If you want to test against a real dovecot or uwash
server, super! check the t/test_runner.pm file for the
settings. They are intentionally unobvious -- please don't
run automated tests unless you're willing to help debug.
The automated results don't help anybody without further
information on the failures. Normally, cpan testers is the
best thing in the world ... IMAP sucks.
1.2034_2: Fri Nov 16 2012
- finally, some testers rand _1 ... didn't tell me anything;
but they ran it. I'm just going to remove the offending
module load. I'm never going to figure out why it fails on
so many machines (but never ever mine).
1.2034_1: Thu Oct 25 2012
- I still have no idea why t/07 fails on basically everyone's
machine except mine, but I did find that croaks and dies are
totally lost because of the way I run the tests.
1.2034: Wed Oct 10 2012
- https://rt.cpan.org/Ticket/Display.html?id=80088
1.2033: Mon Jul 23 2012
- https://rt.cpan.org/Public/Bug/Display.html?id=78539
1.2032: Thu Apr 05 2012
- my school switched to SSLv3 only and they just kinda time
out on autonegotiation... So I added a way to specify the
ssl version.
1.2031: Fri Mar 02 2012
- these tests don't work under this new EV multithreaded
system. Disabled all tests unless people promise to test
single threaded. I'd rather have nobody test it than have
all the tests fail every time. I'll fix the tests later.
1.2030: Mon Feb 06 2012
- fixed bug in get that was fetching more message than there
actually was to get (spuriously appending FLAGS \Seen and
the like)
- made sure the tests run in order (re: EV testers). What I
did is really truly awful. If there is a good way to force
the tests to run in order, please tell it to me. My
solution is just horrible (see top of t/test_server.pm)
1.2029: Mon Jan 30 2012
- spelling fix from the debian people
1.2028: Wed Jan 25 2012
- separator method from glaess@glaessixs
1.2027: Wed Dec 28 2011
- ...
1.20271: Wed Dec 28 2011
- heh, spurious number of tests
1.2027: Fri Dec 23 2011
- deal with this: https://rt.cpan.org/Ticket/Display.html?id=73431
1.2026: Mon Oct 10 2011
- Bug in UID search, contribs by Jorge
1.2025: Fri Sep 02 2011
- removed unused build rules that fail to compile in dmake
1.2024: Tue Aug 02 2011
- Jason Woodard submitted a patch to remove the post-sort from
range2list. I don't recall why the sort was there to begin
with, so the patch seems reasonable to me. All tests
passed, released.
1.2023: Wed May 25 2011
- patch for minor (but annoying) options bug. Thanks Mr. Griffiths!
1.2022: Fri Mar 04 2011
- horrid little typo in socket builder
1.2021: Fri Mar 04 2011
- removed the die() after do("") loading the test server
http://goo.gl/FUQPn
1.2020: Mon Feb 07 2011
- Andrzej Adam Filip requested a CLOSE method for ::PipeSocket
1.2019: Wed Dec 01 2010
- _process_flags() was a little too aggressive about what's a
valid flag and what isn't. Really, it needs to be up to the
server. https://rt.cpan.org/Ticket/Display.html?id=63282
- many doc bugs fixed thanks to HM 2k
1.2018: Thu Oct 28 2010
- minor bug with the sloppy CRLF code
Thanks go to: http://github.com/marado
1.2016: Sun Sep 05 2010
- fixed ipv4 address stuff
1.2016: Wed Sep 01 2010
- added readline callbacks; which I think I may leave
undocumented for now.
1.2016: Mon Aug 30 2010
- found something to fix in https://rt.cpan.org/Ticket/Display.html?id=60537
1.2015: Sun Aug 29 2010
- got the pipesocket working
- made sure it ps works in the context of nisim
1.2014: Sun Aug 15 2010
- added uidsearch() -- just like search()
1.2013: Mon Aug 09 2010
- created the PipeSocket object
- skeled the connect support
1.2013: Sat Aug 07 2010
- added seq()
- added list2range
- added contrib/uidfetch
- fixed a BODY bug in the fetch grammar
1.2012: Sun Aug 01 2010
- added uidcopy()
1.2011_00: Sat Jul 31 2010
- .{32766} appears to be a limit for that type of matching.
I also found a SIGSEGV in (??{ _noexist }) that may or may
not be known. Result? A billion times better interface for
the {#}\r\nstrings .
1.2010_99: Sun Jul 25 2010
- added a logout method that's just like quit, but doesn't
expunge and doesn't have a hardquit option.
1.2010_99: Sat Jul 24 2010
- I really like the way body_summary works and I love writing
grammars, so I wrote a generalized fetch() routine. It
could probably be used by body_summary() in the future.
1.2010: Mon Jul 19 2010
- If the client is not yet setting on a mailbox and a search
is issued, the client now selects the default mbox first.
- RFC3501 wants RFC 2822 dates for date-based searches,
%d-%m-%Y is therefore wrong, it should be %d-%b-%Y (huh).
- provide uidnext, uidvalidity, and uid
- also (incidental to the above) make status() take field
arguments
- fixed a "bug" where not passing coderefs to _process_cmd
will probably cause various crashes.
1.2010: Sun Jul 18 2010
- I was having some issues getting the debugs to work inside
Coro threads. Rather than debugging it properly I just
added more debug options
- changed the behavior of ->top($id) so that )\r\n isn't left
on the end of the last line of headers as they come back.
*** let me know if this broke something for you ***
1.2001: Wed Jul 14 2010
- Ugh. I have seen it before and I already found this
problem. It's still that DateTime bug:
https://rt.cpan.org/Public/Bug/Display.html?id=58459
1.2000_1: Wed Jul 14 2010
- ugh, I'm *STILL* getting that bug (is it?) where sometimes
machines can't copy messages (line 25) after there's
definitely (line 22) 10 messages in the mailbox. WHY WHY WHY
WHY? Naturally, the logdump is truncated at the point where
I really need it.
http://www.cpantesters.org/cpan/report/590a9a6e-8e97-11df-b0b7-6c9e78e28bc1
Changed the t/22 test to dump the last 200 lines instead of
the first few hundred.
1.2000: Tue Jul 06 2010
- Jason and I (due to a disagreement about what should be
returned by body_summary()) begun using objects instead.
This way the return value can be interrogated easily to see
what it is and what it has.
1.2000: Sat Jul 03 2010
- woodward sent in some rfc3501 fetch-body support and docs.
The extension requires Parse::RecDescent for correct
parsing, so body_summary() was forked off to an extensions
module.
1.1916: Mon Jun 07 2010
- woodward sent in an RFC-5256 patch to make SEARCH more correct
1.1915: Sat Jun 05 2010
- import the latest Net-IMAP-Server to the inc/ dir (1.27)
- report various bugs
- fix various bugs in inc/ dir
1.1913: Wed May 26 2010
1.1914: Wed May 26 2010
- pulled in changes from alexmv
1.1912: Fri Apr 23 2010
- Doug confirmed that it worked. I'm going to go ahead and
release this as a new version.
1.1912_1: Thu Apr 22 2010
- Hrm, per Doug Reed at Service Optimi, I noticed that _last
returns self->{last} regardless of whether it's ever been
set. Seems like we can DWIM and call self->select if it's
never been called yet and make ->list (et al) function.
We'll see what he thinks of this fix.
1.1911: Sun Mar 14 2010
- Fixed [introduced] bugs illuminated in #55552 (RT), thanks
to Aaron Wilson for a positively excellent
bug report!
1.1910_2: Wed Feb 17 2010
- http://www.nntp.perl.org/group/perl.cpan.testers/2010/02/msg6764802.html
- I still can't figure out what's causing this... NO IDEA
- I made the test ridiculously verbose if two conditions are
met: 1) automated testing; 2) the copy tests fail in some
way.
1.1910_1: Sun Jan 17 2010
- http://www.nntp.perl.org/group/perl.cpan.testers/2010/01/msg6625605.html
It seems the t/22_* tests are failing, but I can't seem to
build a perl for which the tests fail. :( No idea.
I added another prereq to the makefile and added another
line (perhaps informative?) to the t/22_copy* test.
1.1910: Tue Oct 27 2009
- documented search() and added a bunch of kid functions that
issue searches on your behalf. Added tests for search().
1.1908: Thu Sep 24 2009
- top() does a surprisingly terrible job at groking header
lines. If you have something like this:
message-id:
date: wednesday, blarg blarg
xx:xx:xx (pdt)
The results are somewhat random concerning, lines vs
header-rows. My goal is to make sure each element of the
arrayref returned is a header line, not just a line of text.
1.1908: Sun Sep 20 2009
- added a really weak search command. I think we can do a
little better...
1.1907: Sun Jul 26 2009
- PREAUTH fix and tests
- a nifty little contrib/ dovecot pipe server thingy
- fixed serious issues with the greeting timeout
1.1905: Mon Jul 20 2009
- I apparently need Class::Accessor installed for tests.
Pulling over all deps of the now included net-imap-server
1.1904: Fri Jul 17 2009
- bestpractical's patch makes more sense than mine does
1.1903: Fri Jul 17 2009
- actually use the inc/ copy of net-imap-server
1.1902: Fri Jul 17 2009
- I decided to include a static copy of net-imap-server so I
know precisely what version is there for tests. Suggested
net-imap-server build tests using net-imap-simple this way.
1.1902: Thu Jul 16 2009
- There's apparently 5.10 problems with the tests (probably
not with the module). The tests are kinda hinky anyway.
1.1900: Fri Jul 10 2009
- I really thought I released this already. Lawl.
1.1900: Fri Jun 26 16:03:16 EDT 2009
- prolly going to release this, it seems to test fine all over
the place.
1.1899_07: Sun Jun 21 07:16:36 EDT 2009
- I decided to do get() my way, without ruining everything, by
blessing the arrayref and overloading '""'.
- I tought the t/35 test to prove that _process_command fails
just as Jonathan Kamens says.
- applied JIK's patch.
1.1899_07: Sat Jun 20 22:12:00 EDT 2009
- I want to change the way get() works. I don't think I
should, but I'd like to return the actual message in scalar
context and the lines in list context. Returning the lines
as an arrayref makes no sense to me.
1.1899_07: Sat Jun 20 15:26:13 EDT 2009
- while trying to get some delete and copy tests I ended up
working on expunge_mailbox() a little
- found another bug in Net::IMAP::Server::Mailbox... It's
clearly just a demo, but since I'm using it for my tests,
it's worth fixing.
- my delete tests do show that ranges like 3:5 really do work,
which makes me think RT#40203 may turn out to be spurious.
I'll let the tests prove it out before I close it though.
- I refactored the _reselect() stuff away, it was poorly
thought out. There's a _clear_cache() instead. Yeah, 40203
appears to be bogus because the client doesn't really parse
the sequence-set numbers. I have confirmed for sure that
you can $imap->delete("3:5,7,10") and it'll work just like
you called delete 5 times.
- Copies seem to work fine too. I'm going to close the
ticket.
- Documented the sequence set stuff so RT#40203 doesn't come
up again.
1.1899_06: Fri Jun 19 08:54:07 EDT 2009
- added a status() sub for the STATUS command
- added a status() test, with some unseen() flag tests
- added a select() and current_mailbox() test -- failed to unescape
the working mailbox for current_mailbox()
- reported a status command bug (in Mailbox) to
Net::IMAP::Server
- moved a bunch of contrib and t7lib modules around to keep
pause from indexing them.
- worked on the docs for seen and unseen
- created a method for error-checking when using msg_flags(),
seen() and unseen() -- which I think solves ticket 33189.
Basically, if Cyrus-imap is returning different values for
FETCH (FLAGS) than for STATUS, what can I really do to fix
it? However, the log provided by Mr Spiegl seems to suggest
he was counting errors as unseen messages... so this may
just fix it.
1.1899_05: Wed Jun 17 06:25:39 EDT 2009
- documented see, unsee, add_flags, and sub_flags
- used the IMAP RFC to show that gmail is wrong,
Net::IMAP::Server is right. google apps for domains
apparently selects an unseen message willy nilly (or which
ever is last) for the OK [UNSEEN #] message. It should be
the *first* unseen message. Their IMAP is notoriously
un-IMAP though. I shouldn't be so surprised.
- added undelete to go with the other flaggy functions
- added more flag tests
1.1899_05: Tue Jun 16 06:42:16 EDT 2009
- I started working on ticket 45953,
- created sub_flags() and add_flags()
- taught delete() to use add_flags() -- adds \Deleted
- providing see() and unsee() for ticket 45953
- I started building tests for the flag manipulation stuff and
put reselect stuff ... noticed a possible bug in
Net::IMAP::Server
1.1899_05: Sun Jun 14 07:14:54 EDT 2009
- fixed t/test_server.pm (use IO::Socket::INET, not Net::TCP)
1.1899_04: Sat Jun 13 18:33:46 EDT 2009
- added deleted() from JIK 's
patch.
1.1899_03: Sat Jun 13 17:05:55 EDT 2009
- added a connection class so we might reject connections
after the 4th, or whatever, and possibly solve ticket 30229
- banged my head on the IO::Socket::SSL wall for a while
- buu (#perl freenode) set me straight on something enabling
me to close 30229.
1.1899_02: Sat Jun 13 07:39:29 EDT 2009
- moved some tests around and fixed the manifests
- added support, docs and test for EXAMINE
1.1899_01: Fri Jun 12 22:06:36 EDT 2009
- man Coro is disaggreable in the shutdown epoch, it took a
fork, a setsid and another fork to disssociate the test from
the Coro ... um... messing with exit().
- decided as I clear tickets from RT, I'll write tests. As I
write tests, I'll release dev releases, the *goal* will be
1.1900 -- all RT cleared.
1.1900: Thu Jun 11 07:17:13 EDT 2009
- fixed a bug I created in select
- moved the tests around a little, getting ready for a whole
suite
1.1900: Wed Jun 10 22:01:53 EDT 2009
- It took me forever to figure out why the append command
wouldn't work. Bug submitted to Net::IMAP::Server
- added my login function to contrib
- I think I fixed the oldest bug on RT
1.1810: Sun Jun 7 10:52:30 EDT 2009
- made $imap->select return "0E0" when 0 messages are found
after an otherwise successful select.
1.1810: Sat Jun 6 22:13:34 EDT 2009
- Started working on the tests. Net::IMAP::Simple doesn't
seem to be able to handle the results of a select command as
returned by Net::IMAP::Server. This may indicate other
problems with protocol compliance. I can't say definitley
for sure that it's ::Simple, but that's the most likely
suspect.
- Made the module pull in IO::Socket::SSL without needing to
involve another module that probably shouldn't be a whole
separate distribution anyway. Considering deprecating the
Net::IMAP::Simple::SSL for that reason, and because that
whole distribution is only 2 useful lines anyway.
1.1800: Thu Jun 4 21:44:59 EDT 2009
- jettero started pulling in his changes.
1.17 2006-10-11
- Beta/Developer release -> production
1.16_1 2006-10-02
- Beta Release
- Added debugging
- Upgraded imap.pl example script
- Updated documentation
- Added a few patches here and there
1.16 2006-06-13
- Multiple bugs identified by nate@cs.wisc.edu. Patch
provided by Nate. Nate also provided new release tests -
thanks man.
1.15 2005-11-21
- Added mailboxes_subscribed() function introduced by John
Cappiello. This function provides a method for retreiving
a list of mailboxes which the user has subscribed to. This
differs from the mailboxes() function in that with the
mailboxes() function all mailboxes are returned, regardless
ass to whether or not the user has subscribed to them.
1.14 2005-10-01
- Fixed error in sample code within the POD documentation
identified by Matthew S. Hallacy
1.13 2005-09-28
- Versioning schema changed to use CVS versioning rather than
hard coded versioning. This is to address issues some
people are having with bug tracking and package management
tools.
0.105 2005-09-28
- Fixed syntax problem in the bindaddr option. Thanks
Dagobert Michelsen for pointing this out.
0.104 2005-08-06
- Fixed major bug discovered in get() and getfh() which
caused message lines to be dropped if they started with an
"*"
0.103 2005-07-10
- Fixed error in select() identified by Guido Kerkewitz and
Jonathan B. Glatt
- Added folder_subscribe() and folder_unsubscribe() functions
provided by Guido Kerkewitz.
0.102 2005-06-25
- Fixed protocol error identified within the
expunge_mailbox() function. (Thanks alot to William Faulk
for pointing this out)
- Fixed bugs in the sample imap.pl script provided.
- Added flags() and recent() routines
- Added current_box() function
- Added use_select_cache and select_cache_ttl options. These
options will allow you to enable internal caching for
select() operations.
0.101 2005-01-06
- Fixed bug which resulted in inconsistant results from
login()
0.100 2005-14-05
- Fixed dates in Changes file
- Fixed IMAP protocol error identified by John A. Murphy
- Changed behavior of login() to only return true or false.
This change means that to get the current number of
messages in a users INBOX folder you will need to preform a
simple $imap->select("INBOX") after successfully logging
in.
- Added messages() function
- Added the frame work within select() to provide more
detailed information about the current IMAP framework
0.99 2005-28-04
- Added multi-line header patch for bug discovered in top(),
thanks Sergey Mudrik for pointing this out.
0.98 2005-27-04
- Minor document changes
- Fixed implimentation bug with the new option set
0.97 2005-26-04
- Added patch submitted by LTHEGLER to address the multiple
line output problem.
0.96 2005-26-04
- Took over module development (Colin Faber)
- Fixed synopsis to provide a functional example (Colin
Faber)
- Added error handling (Colin Faber)
- Added IPv6 support (Colin Faber)
- Added port, timeout, use_v6, retry, retry_delay and
bindaddr options to the object creation method.
0.95 2004-06-09
- Accept port configuration (Matt Bradford).
- Documentation overhaul (Casey West).
- Huge internal code overhaul (Casey West).
- Implemented expunge_mailbox() (Florin Andrei).
0.94 Thu May 20 15:24:21 EDT 2004
- Taken by Casey West.
- Quoted the password argument to login() when sending to
IMAP LOGIN command.
- Added arguments for searching in paths and for mailboxes in
the mailboxes() command.
- Distribution clean up.
0.93 Thu Dec 16 16:15:00 1999
- LIST ... {\d}\r\nmailbox parsing in mailboxes()
- better escaping of \" e \\ (Netscape server doesn't put
the \\ in the mailbox name. Why?)
0.92 Tue Dec 13 15:07:00 1999
- seen method
- \r\n as EOL. Thanks to Edward Chao!
- \" escaping. Thanks to Edward Chao!
0.91 Tue Nov 9 11:41:00 1999
- getfh method
- fixed bugs in the documentation(!!!)
0.90 Wed Nov 3 15:29:13 1999
- original version; created by h2xs 1.18
Net-IMAP-Simple-1.2209/META.yml 0000640 0001750 0001750 00000001266 13117505001 015465 0 ustar jettero jettero ---
abstract: unknown
author:
- 'Paul Miller '
build_requires:
ExtUtils::MakeMaker: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005'
keywords:
- imap
- simple
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: Net-IMAP-Simple
no_index:
directory:
- t
- inc
requires:
IO::Select: '0'
IO::Socket: '0'
Parse::RecDescent: '0'
perl: '5.008'
resources:
repository: http://github.com/jettero/net--imap--simple
version: '1.2209'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
Net-IMAP-Simple-1.2209/README 0000644 0001750 0001750 00000001115 12224536034 015101 0 ustar jettero jettero NAME
Net::IMAP::Simple - Perl extension for simple IMAP account handling.
SYNOPSIS
use strict;
use warings;
use Net::IMAP::Simple;
my $server = Net::IMAP::Simple->new( 'someserver' );
$server->login( 'someuser', 'somepassword' );
for ( 1 .. $server->select( 'somefolder' ) ) {
print $email->header('Subject'), "\n";
}
$server->quit();
COPYRIGHT
All rights reserved. This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
BUGS
https://rt.cpan.org/Dist/Display.html?Queue=Net-IMAP-Simple
Net-IMAP-Simple-1.2209/MANIFEST 0000644 0001750 0001750 00000002024 13117505001 015342 0 ustar jettero jettero .perlcriticrc
Changes
contrib/33189_attach.pl
contrib/connectalot.pl
contrib/hand_test01.pl
contrib/imap.pl
contrib/preauth-pipe-server.pl
contrib/search-test.pl
contrib/status.pl
inc/rebuild_iff_necessary.pm
inc/slurp_fetchmail.pm
lib/Net/IMAP/Simple.pm
lib/Net/IMAP/Simple.pod
lib/Net/IMAP/Simple/PipeSocket.pm
lib/Net/IMAP/SimpleX.pm
lib/Net/IMAP/SimpleX.pod
Makefile.PL
MANIFEST
README
t/01_load.t
t/07_select_and_examine.t
t/08_selectalot.t
t/10_list.t
t/11_mailboxes.t
t/15_flags.t
t/16_exotic_flags.t
t/17_status_and_select.t
t/19_readline_callback.t
t/22_copy_multiple.t
t/22_uidcopy_multiple.t
t/23_delete_multiple.t
t/35_imap_results_in_message_body.t
t/42_preauth_with_command.t
t/45_search.t
t/50_body_summary.t
t/55_uid_stuff.t
t/60_fetch_with_grammar.t
t/70_list2range.t
t/75_back_and_forth.t
t/80_top.t
t/critic.t
t/pod.t
t/pod_coverage.t
t/test_runner.pm
TODO
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
Net-IMAP-Simple-1.2209/Makefile.PL 0000644 0001750 0001750 00000001614 13117223063 016174 0 ustar jettero jettero use ExtUtils::MakeMaker;
use ExtUtils::Command qw(cp);
=cut
SimpleX.%: contrib/SimpleX.%
$(RM) $@; $(CP) $< $@ && $(CHMOD) 0444 $@
inc/slurp_fetchmailx.pm: inc/slurp_fetchmail.pm
sed -e s/slurp_fetchmail/slurp_fetchmailx/ -e s/Net::IMAP::Simple/Net::IMAP::SimpleX/ $< > $@
=cut
WriteMakefile(
'NAME' => 'Net::IMAP::Simple',
'VERSION_FROM' => 'lib/Net/IMAP/Simple.pm',
AUTHOR => 'Paul Miller ',
PREREQ_PM => {
'IO::Socket' => 0,
'IO::Select' => 0,
'Parse::RecDescent' => 0,
},
($ExtUtils::MakeMaker::VERSION ge '6.48'?
(MIN_PERL_VERSION => 5.008,
META_MERGE => {
keywords => [qw(imap simple)],
resources=> {
repository => 'http://github.com/jettero/net--imap--simple',
},
},
LICENSE => 'perl_5'
) : ()),
);
Net-IMAP-Simple-1.2209/META.json 0000640 0001750 0001750 00000002246 13117505001 015634 0 ustar jettero jettero {
"abstract" : "unknown",
"author" : [
"Paul Miller "
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005",
"keywords" : [
"imap",
"simple"
],
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "Net-IMAP-Simple",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"IO::Select" : "0",
"IO::Socket" : "0",
"Parse::RecDescent" : "0",
"perl" : "5.008"
}
}
},
"release_status" : "stable",
"resources" : {
"repository" : {
"url" : "http://github.com/jettero/net--imap--simple"
}
},
"version" : "1.2209",
"x_serialization_backend" : "JSON::PP version 2.27300"
}
Net-IMAP-Simple-1.2209/t/ 0000750 0001750 0001750 00000000000 13117505001 014451 5 ustar jettero jettero Net-IMAP-Simple-1.2209/t/16_exotic_flags.t 0000644 0001750 0001750 00000001016 13116325326 017627 0 ustar jettero jettero use strict;
use warnings;
use Test;
use Net::IMAP::Simple;
plan tests => our $tests = 3;
our $imap;
sub run_tests {
my $nm = $imap->select('testing')
or die " failure selecting testing: " . $imap->errstr . "\n";
$imap->put( testing => "Subject: test message" );
$imap->add_flags(1 => qw(blarg fluurg carmel) );
my @flags = $imap->msg_flags(1);
ok( (grep {m/blarg/} @flags), 1 );
ok( (grep {m/fluurg/} @flags), 1 );
ok( (grep {m/carmel/} @flags), 1 );
}
do "./t/test_runner.pm";
Net-IMAP-Simple-1.2209/t/pod_coverage.t 0000644 0001750 0001750 00000000711 13116325326 017310 0 ustar jettero jettero use strict;
use Test::More;
if (not $ENV{TEST_AUTHOR}) {
plan( skip_all => 'Author test. Set $ENV{TEST_AUTHOR} to true to run.');
}
eval "use Test::Pod::Coverage 1.00";
plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD" if $@;
my %params = (
'Net::IMAP::Simple::PipeSocket' => {trustme=>['.']},
);
my @modules = all_modules();
plan tests => scalar @modules;
for my $m (@modules) {
pod_coverage_ok( $m, $params{$m} );
}
Net-IMAP-Simple-1.2209/t/35_imap_results_in_message_body.t 0000644 0001750 0001750 00000001255 13116325326 023104 0 ustar jettero jettero use strict;
use warnings;
use Test;
use Net::IMAP::Simple;
plan tests => our $tests = 1;
my $special_message = <<"HERE";
From: me
To: you
Subject: supz!
1 OK FETCH COMPLETED\r
2 OK FETCH COMPLETED\r
3 OK FETCH COMPLETED\r
4 OK FETCH COMPLETED\r
5 OK FETCH COMPLETED\r
Hi, this is a message, do you like it?
HERE
our $imap;
sub run_tests {
my $nm = $imap->select('testing')
or die " failure selecting testing: " . $imap->errstr . "\n";
$imap->put( testing => $special_message );
my $return = $imap->get(1);
$special_message =~ s/\x0d?\x0a/\x07/g;
$return =~ s/\x0d?\x0a/\x07/g;
ok( $return, $special_message );
}
do "./t/test_runner.pm";
Net-IMAP-Simple-1.2209/t/17_status_and_select.t 0000644 0001750 0001750 00000001454 13116325326 020673 0 ustar jettero jettero use strict;
use warnings;
use Test;
use Net::IMAP::Simple;
plan tests => our $tests = 6;
our $imap;
sub run_tests {
my $nm = $imap->select('testing')
or die " failure selecting testing: " . $imap->errstr . "\n";
if( $nm ) {
$imap->delete("1:$nm");
$imap->expunge_mailbox;
}
ok( $imap->select("testing")+0, 0 );
$imap->put( testing => "Subject: test-$_\n\ntest-$_", '\Seen' ) for 1 .. 10;
my ($unseen, $recent, $total) = $imap->status;
ok( "unseen $unseen", "unseen 0" );
ok( "total $total", "total 10" );
$imap->unsee($_) for 5,7;
ok( "funseen " . $imap->unseen, 'funseen 2' );
($unseen, $recent, $total) = $imap->status;
ok( "unseen $unseen", "unseen 2" );
ok( "total $total", "total 10" );
}
do "./t/test_runner.pm";
Net-IMAP-Simple-1.2209/t/70_list2range.t 0000644 0001750 0001750 00000000542 13116325326 017235 0 ustar jettero jettero use strict;
use warnings;
use Test;
use Net::IMAP::Simple;
plan tests => 2;
my @a = sort { rand()<=>rand() } (1 .. 50, 90 .. 99, 1000 .. 1010, 3..10);
ok( Net::IMAP::Simple->list2range(@a), my $result = "1:50,90:99,1000:1010" );
my %h;
my @b = sort { $a<=>$b } grep {!$h{$_}++} @a;
my @c = Net::IMAP::Simple->range2list($result);
ok( "@c", "@b" );
Net-IMAP-Simple-1.2209/t/55_uid_stuff.t 0000644 0001750 0001750 00000001563 13116325326 017162 0 ustar jettero jettero use strict;
use warnings;
use Test;
use Net::IMAP::Simple;
plan tests => our $tests = 7;
our $imap;
sub run_tests {
my $nm = $imap->select('testing')
or die " failure selecting testing: " . $imap->errstr . "\n";
my @uidnext = ($imap->uidnext);
$imap->put( testing => "Subject: test1" ); push @uidnext, $imap->uidnext;
$imap->put( testing => "Subject: test2" );
my @seq = $imap->search_since("1-Jan-1971");
my @uid = $imap->uid(do{local $"=","; "@seq"});
my @aud = $imap->uid();
for( 0 .. $#uid ) {
ok($uid[$_], $aud[$_]);
ok($uid[$_], $uidnext[$_]);
}
ok( $imap->uidnext, $uid[-1]+1 ); # this is (perhaps) Net-IMAP-Server specific ... perhaps
ok( $imap->uidvalidity ); # how could we test this?
my @ssuid = $imap->uidsearch("since 1-Jan-1971");
ok( "@ssuid", "@uid" );
}
do "./t/test_runner.pm";
Net-IMAP-Simple-1.2209/t/75_back_and_forth.t 0000644 0001750 0001750 00000002533 13116325326 020116 0 ustar jettero jettero use strict;
use warnings;
use Test;
use Net::IMAP::Simple;
plan tests => (our $tests = 10 + 3);
our $imap;
sub run_tests {
my $nm = $imap->select('testing')
or die " failure selecting testing: " . $imap->errstr . "\n";
$imap->create_mailbox('test');
ok( $imap->select("testing")+0, 0 );
$imap->put( testing => "Subject: test-$_\n\ntest-$_" . "\n" . (" xxxxxx " x 2_000), '\Seen' ) for 1 .. $tests;
ok( $imap->select("testing")+0, $tests );
for my $i ( 1 .. ($tests-3) ) {
my $errors = 0;
my $msg = $imap->get($i) or do { $errors ++; warn " " . $imap->errstr };
$imap->put( test => $msg ) or do { $errors ++; warn " " . $imap->errstr };
$imap->delete( $i ) or do { $errors ++; warn " " . $imap->errstr };
ok($errors, 0);
}
# hey, look at that... dovecot produces this error on its own
# [...blib/lib/Net/IMAP/Simple.pm line 1181 in sub _send_cmd] 56 FETCH 913 RFC822\r\n
# [...blib/lib/Net/IMAP/Simple.pm line 725 in sub _process_cmd] 56 BAD Error in IMAP command FETCH: Invalid messageset\r\n
# [...blib/lib/Net/IMAP/Simple.pm line 1201 in sub _cmd_ok] 56 BAD Error in IMAP command FETCH: Invalid messageset\r\n
$imap->get($tests + 9_00); # finishing move
ok( $imap->errstr, qr(Invalid messageset|message not found)i );
}
do "./t/test_runner.pm";
Net-IMAP-Simple-1.2209/t/critic.t 0000644 0001750 0001750 00000000476 13116325326 016140 0 ustar jettero jettero use strict;
use Test::More;
use File::Spec;
if (not $ENV{TEST_AUTHOR}) {
plan( skip_all => 'Author test. Set $ENV{TEST_AUTHOR} to true to run.');
}
eval { require Test::Perl::Critic; };
if ($@) {
plan( skip_all => 'Test::Perl::Critic required for test.');
}
Test::Perl::Critic->import();
all_critic_ok();
Net-IMAP-Simple-1.2209/t/10_list.t 0000644 0001750 0001750 00000001271 13117223063 016124 0 ustar jettero jettero use strict;
use warnings;
use Test;
use Net::IMAP::Simple;
plan tests => our $tests = 5;
our $imap;
sub run_tests {
$imap->create_mailbox("blarg");
my $n = $imap->select("blarg");
$imap->delete("1:$n");
$imap->expunge_mailbox;
$imap->select("blarg");
my $h = $imap->list();
ok( ref $h, "HASH" );
ok( int(keys %$h), 0 );
my $msg = "Subject: test!\n\ntest!";
$imap->put( blarg => $msg );
$imap->select('blarg');
$h = $imap->list();
ok( ref $h, "HASH" );
ok( int(keys %$h), 1 );
my ($v) = values %$h;
my $bytes = $ENV{NIS_TEST_HOST} =~ m/gmail/ ? length($msg) : length($msg)+2;
ok( $v, $bytes )
}
do "./t/test_runner.pm";
Net-IMAP-Simple-1.2209/t/19_readline_callback.t 0000644 0001750 0001750 00000001210 13117223063 020552 0 ustar jettero jettero use strict;
use warnings;
use Test;
use Net::IMAP::Simple;
plan tests => our $tests = 2;
my $append_ok = 0;
my $get_ok = 0;
sub callback_test {
my ($line) = @_;
# e.g.: 5 OK [APPENDUID 1283347568 1002] APPEND COMPLETED
$append_ok ++ if $line =~ m/\d+\s+OK.+?APPENDUID.+?APPEND.+?COMPLETED/i;
$get_ok ++ if $line =~ m/test-\d+!/;
}
our $CALLBACK_TEST = \&callback_test;
our $imap;
sub run_tests {
my $nm = $imap->select("testing");
$imap->put( testing => "Subject: test!\n\ntest-$_!" ) for 1 .. 5;
$imap->get( $_ ) for 1 .. 5;
ok( $append_ok, 5 );
ok( $get_ok, 5 );
}
do "./t/test_runner.pm";
Net-IMAP-Simple-1.2209/t/07_select_and_examine.t 0000644 0001750 0001750 00000003036 13117223063 020767 0 ustar jettero jettero use strict;
no warnings;
use Test;
use Net::IMAP::Simple;
plan tests => our $tests = 16;
our $imap;
my $nm;
sub run_tests {
my $nm = $imap->select("testing") or die "imap error: " . $imap->errstr;
$nm = $imap->select("testing");
$imap->put( testing => "Subject: test!\n\ntest!" ) or die "problem putting message: " . $imap->errstr;
my @c = (
[ scalar $imap->select("fake"), $imap->current_box, $imap->unseen, $imap->last, $imap->recent ],
[ scalar $imap->select("testing"), $imap->current_box, $imap->unseen, $imap->last, $imap->recent ],
[ scalar $imap->select("fake"), $imap->current_box, $imap->unseen, $imap->last, $imap->recent ],
[ scalar $imap->select("testing"), $imap->current_box, $imap->unseen, $imap->last, $imap->recent ],
);
ok( $c[$_][1], "testing" ) for 0 .. $#c;
ok( $c[0][0], undef );
ok( $c[1][0], $nm+1 );
ok( $c[2][0], undef );
ok( $c[3][0], $nm+1 );
ok( "@{ $c[$_] }[2,3,4]", "1 1 0" ) for 0 .. $#c;
## Test EXMAINE
ok( $imap->examine('testing') );
# ok( not $imap->put( testing => "Subject: test!\n\ntest!" ) );
# ok( $imap->errstr, qr/read.*only/ );
# this worked in Net::IMAP::Server -- dovecot apparently lets you append after examine... heh
ok( $nm = $imap->select('testing') );
ok( $imap->put( testing => "Subject: test!\n\ntest!" ), 1 )
or die " error putting test message: " . $imap->errstr . "\n";
ok( $imap->select('testing'), 2 );
}
do "./t/test_runner.pm" == 777 or die "test-runner-failed: $@$!";
Net-IMAP-Simple-1.2209/t/22_copy_multiple.t 0000644 0001750 0001750 00000001201 13116325326 020036 0 ustar jettero jettero use strict;
use warnings;
use Test;
use Net::IMAP::Simple;
plan tests => our $tests = 5;
our $imap;
sub run_tests {
my $nm = $imap->select('testing')
or die " failure selecting testing: " . $imap->errstr . "\n";
ok( $imap->select("testing")+0, 0 );
$imap->put( testing => "Subject: test-$_\n\ntest-$_", '\Seen' ) for 1 .. 10;
ok( $imap->select("testing")+0, 10 );
$imap->create_mailbox("testing2");
my @res;
ok( $res[0] = $imap->copy( "3:5,9", 'testing2' ) );
ok( $res[1] = $imap->copy( "1,7", 'testing2' ) );
ok( $res[2] = $imap->select("testing2"), 6 );
}
do "./t/test_runner.pm";
Net-IMAP-Simple-1.2209/t/50_body_summary.t 0000644 0001750 0001750 00000002523 13117223063 017670 0 ustar jettero jettero use strict;
use warnings;
use Test;
use Net::IMAP::SimpleX;
plan tests => our $tests = 4 + (3+2);
our $imap;
our $USE_SIMPLEX = 1;
sub run_tests {
my $nm = $imap->select('testing')
or die " failure selecting testing: " . $imap->errstr . "\n";
$imap->put( testing => "Subject: test" );
my $bs = $imap->body_summary(1);
ok( not $bs->has_parts() );
ok( not $bs->type() );
ok( not $bs->parts() );
ok( $bs->body()->content_type(), qr"text/plain"i );
$imap->put( testing => <HTML Content
--0-1563833763-1277912078=:86501--
TEST2
$bs = $imap->body_summary(2);
ok( $bs->has_parts() );
ok( $bs->type(), qr"alternative"i );
ok( scalar (my @parts = $bs->parts()), 2 );
ok( $parts[0]->content_type(), qr"text/plain"i );
ok( $parts[1]->content_type(), qr"text/html"i );
# gmail eats the fake charsets
# ok( $parts[0]->charset(), "fake-charset-1" );
# ok( $parts[1]->charset(), "fake-charset-2" );
}
do "./t/test_runner.pm";
Net-IMAP-Simple-1.2209/t/15_flags.t 0000644 0001750 0001750 00000004211 13117223063 016247 0 ustar jettero jettero use strict;
use Test;
use Net::IMAP::Simple;
plan tests => our $tests =
((my $puts = 5)+1)*4 -2 # the put lines
+ 8 # some arbitrary flag tests on message 4
+ 8 # some msg_flags return values
+ 8 # grab flags for some nonexistnat messages, and for some existant ones
;
our $imap;
sub run_tests {
my $nm = $imap->select('testing')
or die " failure selecting testing: " . $imap->errstr . "\n";
ok( 0+$imap->last, 0 );
ok( 0+$imap->unseen, 0 );
for(1 .. $puts) {
ok( $imap->put( testing => "Subject: test-$_\n\ntest-$_" ) );
ok( 0+$imap->last, $_ );
ok( 0+$imap->unseen, $ENV{NIS_TEST_HOST} =~ m/gmail/ ? 1:$_ );
$imap->see($_);
ok( 0+$imap->unseen, 0 );
}
$imap->unsee(4);
$imap->delete(4);
ok( not $imap->seen(4) );
ok( $imap->deleted(4) );
$imap->see(4);
$imap->undelete(4);
ok( $imap->seen(4) );
ok( not $imap->deleted(4) );
$imap->add_flags( 5, qw(\Seen \Deleted) );
ok( $imap->seen(5) );
ok( $imap->deleted(5) );
$imap->sub_flags( 5, qw(\Seen \Deleted) );
ok( not $imap->seen(5) );
ok( not $imap->deleted(5) );
$imap->sub_flags( 4, qw(\Seen \Deleted \Answered) );
$imap->add_flags( 5, qw(\Seen \Deleted \Answered) );
my $w;
my @flags4 = $imap->msg_flags(4); ok( not ($w=$imap->waserr) ); warn $imap->errstr if $w;
my $flags4 = $imap->msg_flags(4); ok( not ($w=$imap->waserr) ); warn $imap->errstr if $w;
my @flags5 = $imap->msg_flags(5); ok( not ($w=$imap->waserr) ); warn $imap->errstr if $w;
my $flags5 = $imap->msg_flags(5); ok( not ($w=$imap->waserr) ); warn $imap->errstr if $w;
ok( 0+@flags4, 0 ); #
ok( 0+@flags5, 3 ); # \Seen \Answered \Deleted
ok( defined $flags4 );
ok( defined $flags5 );
() = $imap->msg_flags(252); ok( $imap->waserr );
ok( not defined $imap->msg_flags(252) );
ok( not defined $imap->seen(252) );
ok( not defined $imap->deleted(252) );
ok( defined $imap->seen(4) );
ok( defined $imap->seen(5) );
ok( defined $imap->deleted(4) );
ok( defined $imap->deleted(5) );
}
do "./t/test_runner.pm";
Net-IMAP-Simple-1.2209/t/pod.t 0000644 0001750 0001750 00000000412 13116325326 015433 0 ustar jettero jettero use strict;
use Test::More;
if (not $ENV{TEST_AUTHOR}) {
plan( skip_all => 'Author test. Set $ENV{TEST_AUTHOR} to true to run.');
}
eval "use Test::Pod 1.00"; ## no critic
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
all_pod_files_ok();
Net-IMAP-Simple-1.2209/t/22_uidcopy_multiple.t 0000644 0001750 0001750 00000001274 13116325326 020552 0 ustar jettero jettero use strict;
use warnings;
use Test;
use Net::IMAP::Simple;
plan tests => our $tests = 5;
our $imap;
sub run_tests {
my $nm = $imap->select('testing')
or die " failure selecting testing: " . $imap->errstr . "\n";
ok( $imap->select("testing")+0, 0 );
$imap->put( testing => "Subject: test-$_\n\ntest-$_", '\Seen' ) for 1 .. 10;
ok( $imap->select("testing")+0, 10 );
$imap->create_mailbox("testing2");
my @_uid359 = $imap->uid("3:5,9");
my @_uid17 = $imap->uid("1,7");
ok($imap->uidcopy( join(",",@_uid359), 'testing2' ) );
ok($imap->uidcopy( join(",",@_uid17), 'testing2' ) );
ok($imap->select("testing2"), 6 );
}
do "./t/test_runner.pm";
Net-IMAP-Simple-1.2209/t/60_fetch_with_grammar.t 0000644 0001750 0001750 00000031203 13116325326 021012 0 ustar jettero jettero use strict;
use warnings;
use Test;
BEGIN {
if( not -f "test_simplex" ) {
plan tests => 1;
print "# skipping all tests, not installing SimpleX\n";
skip(1,1,1);
exit 0;
}
}
use Net::IMAP::SimpleX;
plan tests => our $tests = (
1 # the sample test
+ 1 # keys=5
+ 2 # UIDs
+ 2 # HEADER FIELDS
+ 2 # UID HEADER FIELDS
);
my $sample = q/* 1 FETCH (FLAGS (\Recent) INTERNALDATE "23-Jul-2010 22:21:37 -0400" RFC822.SIZE 402/
. q/ ENVELOPE (NIL "something" NIL NIL NIL NIL NIL NIL NIL NIL) BODYSTRUCTURE (("text" "plain" ("charset" "fake-charset-1")/
. qq/ NIL NIL "7BIT" 15 2)("text" "html" ("charset" "fake-charset-2") NIL NIL "7BIT" 21 2) "alternative"))\x0d\x0a/;
our $imap;
our $USE_SIMPLEX = 1;
sub run_tests {
my $parser = $imap->{parser}{fetch};
my $bool = $parser->fetch_item($sample) ? 1:0;
ok( $bool ) or warn " couldn't parse: $sample";
my $nm = $imap->select('testing')
or die " failure selecting testing: " . $imap->errstr . "\n";
$imap->put(testing=>$_) for get_messages();
my %parts = eval { %{ $imap->fetch(1=>'FULL')->{1} } };
ok( int( keys %parts ), 5 ) or warn do {my @a = keys %parts; "parts(@a)"};
my $res = $imap->fetch('1:*', "UID BODY[HEADER.FIELDS (DATE FROM SUBJECT)]");
my $uid1 = $res->{1}{UID};
my $uid2 = $res->{2}{UID};
ok( $uid1 > 0 and $uid2 > 0 );
ok( $uid1 != $uid2 );
ok( $res->{1}{'BODY[HEADER.FIELDS (DATE FROM SUBJECT)]'} =~ m/1:09.*Paul Miller.*test message/s );
ok( $res->{2}{'BODY[HEADER.FIELDS (DATE FROM SUBJECT)]'} =~ m/4:12.*Paul Miller.*test2/s );
$res = $imap->uidfetch("$uid1,$uid2", "UID BODY[HEADER.FIELDS (DATE FROM SUBJECT)]");
ok( $res->{1}{'BODY[HEADER.FIELDS (DATE FROM SUBJECT)]'} =~ m/1:09.*Paul Miller.*test message/s );
ok( $res->{2}{'BODY[HEADER.FIELDS (DATE FROM SUBJECT)]'} =~ m/4:12.*Paul Miller.*test2/s );
}
do "./t/test_runner.pm";
sub get_messages {
my @messages = (<
Received: from voltar.org (x-x-x-x.lightspeed.klmzmi.sbcglobal.net [0.0.0.0])
by mx.google.com with ESMTPS id n20sm1380887ibe.17.2010.07.24.07.01.10
(version=TLSv1/SSLv3 cipher=RC4-MD5);
Sat, 24 Jul 2010 07:01:11 -0700 (PDT)
Sender: Paul Miller
Date: Sat, 24 Jul 2010 10:01:09 -0400
From: Paul Miller
To: Paul Miller
Subject: test message
Message-ID: <20100724140108.GA19962\@corky>
MIME-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline
User-Agent: Mutt/1.5.20 (2009-06-14)
Status: RO
Content-Length: 158
Lines: 7
this is the test part
--
If riding in an airplane is flying, then riding in a boat is swimming.
116 jumps, 48.6 minutes of freefall, 92.9 freefall miles.
TEST1
From jettero\@cpan.org Sat Jul 24 10:04:15 2010
Return-Path:
Received: from cpan.org (x-x-x-x.lightspeed.klmzmi.sbcglobal.net [0.0.0.0])
by mx.google.com with ESMTPS id e8sm1384214ibb.14.2010.07.24.07.04.14
(version=TLSv1/SSLv3 cipher=RC4-MD5);
Sat, 24 Jul 2010 07:04:14 -0700 (PDT)
Sender: Paul Miller
Date: Sat, 24 Jul 2010 10:04:12 -0400
From: Paul Miller
To: Paul Miller
Subject: test2
Message-ID: <20100724140412.GA20361\@corky>
MIME-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline
User-Agent: Mutt/1.5.20 (2009-06-14)
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2 test2
test2 test2 test2 test2 test2
--
If riding in an airplane is flying, then riding in a boat is swimming.
116 jumps, 48.6 minutes of freefall, 92.9 freefall miles.
TEST2
}
Net-IMAP-Simple-1.2209/t/80_top.t 0000644 0001750 0001750 00000001164 13116325326 015767 0 ustar jettero jettero
use strict;
use warnings;
use Test;
use Net::IMAP::Simple;
plan tests => our $tests = 3;
our $imap;
sub run_tests {
$imap->create_mailbox("blarg");
my $n = $imap->select("blarg");
$imap->delete("1:$n");
$imap->expunge_mailbox;
$imap->select("blarg");
$imap->put( blarg => "Subject: test$_\n\ntest$_" ) for 1..2;
my @r = $imap->top;
my @a = "@r" =~ m/(test\d+)/g;
ok( "@a", "test1 test2" );
@r = $imap->top(1);
@a = "@r" =~ m/(test\d+)/g;
ok( "@a", "test1" );
@r = $imap->top(2);
@a = "@r" =~ m/(test\d+)/g;
ok( "@a", "test2" );
}
do "./t/test_runner.pm";
Net-IMAP-Simple-1.2209/t/45_search.t 0000644 0001750 0001750 00000001151 13116325326 016427 0 ustar jettero jettero use strict;
use warnings;
use Test;
use Net::IMAP::Simple;
plan tests => our $tests =
(my $puts = 5)*1
+1 # startup
+2 # subject searches
;
our $imap;
sub run_tests {
my $nm = $imap->select('testing')
or die " failure selecting testing: " . $imap->errstr . "\n";
ok( 0+$imap->search_unseen, 0 );
for my $pnum (1 .. $puts) {
$imap->put( testing => "Subject: test-$pnum\n\ntest-$pnum" );
ok( 0+$imap->search_unseen, $pnum );
}
ok( 0+$imap->search_subject("test-"), $puts );
ok( 0+$imap->search_subject("test-3"), 1 );
}
do "./t/test_runner.pm";
Net-IMAP-Simple-1.2209/t/01_load.t 0000644 0001750 0001750 00000000154 13116325326 016073 0 ustar jettero jettero
use strict;
use warnings;
use Test;
plan tests => 1;
ok(eval "use Net::IMAP::Simple; 1") or warn " $@";
Net-IMAP-Simple-1.2209/t/08_selectalot.t 0000644 0001750 0001750 00000001015 13116325326 017317 0 ustar jettero jettero use strict;
use Test;
use Net::IMAP::Simple;
plan tests => our $tests = 3;
our $imap;
sub run_tests {
$imap->select("testing") or warn " \e[1;33m" . $imap->errstr . "\e[m\n";
ok( $imap->current_box, "testing" );
$imap->select("reallynowaythissuckerexistsIhope");
ok( $imap->current_box, "testing" );
$imap->create_mailbox("anotherthingy");
$imap->select("anotherthingy") or warn " \e[1;33m" . $imap->errstr . "\e[m\n";
ok( $imap->current_box, "anotherthingy" );
}
do "./t/test_runner.pm";
Net-IMAP-Simple-1.2209/t/test_runner.pm 0000644 0001750 0001750 00000007211 13117223063 017372 0 ustar jettero jettero our $tests;
our $imap;
use strict;
use IO::Socket::INET;
use Time::HiRes qw(time);
use Fcntl qw(:flock);
no warnings;
#
# There used to be a little stand alone server than ran in this test suite. It
# was totally unreliable and I tired of trying to maintain it. You must now
# test against your own server if you wish to test. I highly recommend
# skipping the tests. If you choose to report errors, please also explain why
# they failed.
#
### these tests are all tuned for gmail, used to test best on dovecot ###
#
# For example, the last failures from CPAN Testers seemed to be segmentation
# faults in SSL that I couldn't reproduce at my house or at work. Not really a
# perl problem and not really something I can fix.
#
# On the other hand, it could be a simple network or process management error.
# How can I tell from here? TAP wasn't really set up to deal with process
# management the way I was doing it. I gave up.
#
# If you want to test, set these environment variables and run the tests.
# These settings are intentionally un-obvious. If you want to run automated
# tests please help debug the failures. Automated test results against unknown
# environments help absolutely nobody at all. Your IMAP server will differ
# from mine, so some of the tests will fail and I won't have any ability to
# figure out why without your /tmp/ logs and/or some help. With most modules
# cpan testers is the best thing in the entire world. With IMAP, not so much.
#
# ** THIS WILL DESTROY ANY FOLDERS YOU HAVE NAMED
# ** TESTING, TESTING2 OR TESTING3
#
# export NIS_TEST_HOST=someserver.org
# export NIS_TEST_USER=someguyname
# export NIS_TEST_PASS=blarg
#
# ** THIS WILL DESTROY ANY FOLDERS YOU HAVE NAMED
# ** TESTING, TESTING2 OR TESTING3
#
# HOST will get connections on 143 and 993, specifying a port is not possible
# at this time.
#
#
open my $lock, ">", "t/test_runner.pm.lock" or die "couldn't open lockfile: $!";
flock $lock, LOCK_EX or die "couldn't lock lockfile: $!";
unless( exists $ENV{NIS_TEST_HOST} and exists $ENV{NIS_TEST_USER} and exists $ENV{NIS_TEST_PASS} ) {
ok($_) for 1 .. $tests; # just skip everything
my $line = "[not actually running any tests -- see t/test_runner.pm]";
my $len = length $line; $len ++;
print STDERR "\e7\e[5000C\e[${len}D$line\e8";
exit 0;
}
open INFC, ">/tmp/client-run-" . time . ".log";
# we don't care very much if the above command fails
our $CALLBACK_TEST;
my @c = $CALLBACK_TEST ? (readline_callback => $CALLBACK_TEST) :();
our $USE_SIMPLEX;
my $class = $USE_SIMPLEX ? "Net::IMAP::SimpleX" : "Net::IMAP::Simple";
$imap = $class->new($ENV{NIS_TEST_HOST}, debug=>\*INFC, @c, use_ssl=>1) or die "\nconnect failed: $Net::IMAP::Simple::errstr\n";
$imap->login(@ENV{qw(NIS_TEST_USER NIS_TEST_PASS)});
if( __PACKAGE__->can('run_tests') ) {
for my $mb (qw(testing testing1 testing2 testing3)) {
$imap->create_mailbox($mb);
my $nm = $imap->select($mb);
if( $nm > 0 ) {
$imap->delete("1:$nm");
$imap->expunge_mailbox;
}
}
eval {
run_tests();
1} or warn "\nfail: $@\n";
for my $mb (qw(test anotherthing blarg testing testing1 testing2 testing3)) {
my $nm = $imap->select($mb);
if( defined $nm ) {
if ( $nm > 0 ) {
$imap->delete("1:$nm");
$imap->expunge_mailbox;
}
# must get off the selected mailbox before delete
# or imap expects us to quit and will die in weird ways
$imap->select("INBOX");
$imap->delete_mailbox($mb);
}
}
} else {
warn "weird, no tests";
}
777;
Net-IMAP-Simple-1.2209/t/42_preauth_with_command.t 0000644 0001750 0001750 00000002236 13116325326 021365 0 ustar jettero jettero use strict;
no warnings;
# NOTE: To use this test, you have to enter a PREAUTH server command into your
# ~/.ppsc_test file and make sure you have File::Slurp installed.
#
# Example command:
#
# echo ssh -C blarghost exec dovecot --exec-mail imap > ~/.ppsc_test
#
use Test;
use Net::IMAP::Simple;
plan tests => our $tests = 1;
sub fixeol($) { $_[0] =~ s/[\x0d\x0a]+/\n/g }
my $time = localtime;
my $msg = <<"HERE";
From: me
To: you
Subject: NiSim Test - $time
$time
NiSim Test
HERE
#open INFC, ">>", "informal-imap-client-dump.log" or die $!;
my $cmd;
if( my $t = "$ENV{HOME}/.ppsc_test" ) {
eval q +
use File::Slurp qw(slurp);
$cmd = slurp("$ENV{HOME}/.ppsc_test");
chomp $cmd;
+;
}
unless( $cmd ) {
skip(1,1,1);
exit 0;
}
my $imap = Net::IMAP::Simple->new("cmd:$cmd", #debug=>\*INFC
) or die "\nconnect failed: $Net::IMAP::Simple::errstr\n";
$imap->create_mailbox('testing');
my $nm = $imap->select('testing')
or die " failure selecting testing: " . $imap->errstr . "\n";
$imap->put( testing => $msg ); my $gmsg =
$imap->get( $nm + 1 );
$imap->delete_mailbox('testing');
fixeol($msg);
fixeol($gmsg);
ok( $gmsg, $msg );
Net-IMAP-Simple-1.2209/t/23_delete_multiple.t 0000644 0001750 0001750 00000001165 13116325326 020340 0 ustar jettero jettero use strict;
use warnings;
use Test;
use Net::IMAP::Simple;
plan tests => our $tests = 4;
our $imap;
sub run_tests {
my $nm = $imap->select('testing')
or die " failure selecting testing: " . $imap->errstr . "\n";
ok( $imap->select("testing")+0, 0 );
$imap->put( testing => "Subject: test-$_\n\ntest-$_", '\Seen' ) for 1 .. 10;
$imap->delete( "3:4,6" ) or warn $imap->errstr;
my @e = $imap->expunge_mailbox;
ok( not $imap->waserr );
ok( "@e", qr(6 4 3|3 3 4) ); # (rational dovecot following imap sec | gmail doing its own thing)
ok( $imap->last, 7 );
}
do "./t/test_runner.pm";
Net-IMAP-Simple-1.2209/t/11_mailboxes.t 0000644 0001750 0001750 00000000556 13116325326 017146 0 ustar jettero jettero use strict;
use Test;
use Net::IMAP::Simple;
plan tests => our $tests = 2;
our $imap;
sub run_tests {
$imap->create_mailbox("anotherthingy");
my @e = $imap->mailboxes;
my @E = qw(testing anotherthingy);
for my $__e (@E) {
ok(1) if grep { $_ eq $__e } @e; # would use ~~ but would rule out 5.8 boxes
}
}
do "./t/test_runner.pm";
Net-IMAP-Simple-1.2209/.perlcriticrc 0000644 0001750 0001750 00000000340 11462543612 016711 0 ustar jettero jettero severity = 4
verbose = 8
exclude = ValuesAndExpressions::ProhibitConstantPragma Subroutines::RequireArgUnpacking Modules::RequireFilenameMatchesPackage Modules::ProhibitMultiplePackages TestingAndDebugging::ProhibitNoStrict
Net-IMAP-Simple-1.2209/TODO 0000644 0001750 0001750 00000000324 11462543612 014715 0 ustar jettero jettero - there should be tests for the new search()
- there should be tests for the newly repaird top()
- search() should get fancier, dunno how
- search() should be documented ... er... when it's ... desgined properly
Net-IMAP-Simple-1.2209/contrib/ 0000750 0001750 0001750 00000000000 13117505001 015646 5 ustar jettero jettero Net-IMAP-Simple-1.2209/contrib/hand_test01.pl 0000755 0001750 0001750 00000000712 11462543612 020340 0 ustar jettero jettero #!/usr/bin/perl
use strict;
use warnings;
use lib 'inc', "blib/lib", "blib/arch";
use rebuild_iff_necessary;
use slurp_fetchmail;
use Data::Dump qw(dump);
my $imap = slurp_fetchmail->login(use_ssl=>1);
my @c;
for my $box (map {split m/\s+/} (@ARGV ? @ARGV : ("INBOX"))) {
push @c, {
selectres => dump($imap->select($box)),
box => $imap->current_box, first_unseen=>$imap->unseen, recent=>$imap->recent,
};
}
warn dump(@c) . "\n";
Net-IMAP-Simple-1.2209/contrib/preauth-pipe-server.pl 0000755 0001750 0001750 00000002263 11462543612 022140 0 ustar jettero jettero #!/usr/bin/perl
use strict;
use Net::Server;
use base 'Net::Server::PreFork';
use IPC::Open3;
use IO::Select;
my $port = shift;
my @cmd = @ARGV;
die "port cmd cmd cmd cmd cmd cmd cmd" unless $port and @cmd;
sub process_request {
my $this = shift;
my ($wtr, $rdr, $err);
my $pid = open3($wtr, $rdr, $err, @cmd);
$rdr->blocking(0);
STDIN->blocking(0);
my $select = IO::Select->new($rdr, \*STDIN);
TOP: while(1) {
if( my @handles = $select->can_read(1) ) {
for(@handles) {
my $at_least_one = 0;
while( my $line = $_->getline ) {
if( $_ == $rdr ) {
print STDOUT $line;
$this->log(1, "[IMAP] $line");
} else {
print $wtr $line;
$this->log(1, "[CLNT] $line");
}
$at_least_one ++;
}
last TOP unless $at_least_one;
}
}
}
$this->log(1, "[KILL] $pid must die");
kill -1, $pid;
kill -2, $pid;
waitpid $pid, 0;
return;
}
main->run(port=>$port, log_file=>"ppsc.log");
Net-IMAP-Simple-1.2209/contrib/connectalot.pl 0000755 0001750 0001750 00000001706 11462543612 020543 0 ustar jettero jettero #!/usr/bin/perl
use strict;
use warnings;
use IO::Socket::INET;
use IO::Socket::SSL;
my $ppid = $$;
END { print "[$$] ", $$==$ppid ? "ppid ":"", "exit\n" };
print "[$$] ppid started\n";
$SIG{__WARN__} = sub { print "[$$] $_[0]" };
$SIG{__DIE__} = sub { print "[$$] $_[0]"; exit 0 };
my $class = $ENV{ca_use_ssl} ? "IO::Socket::SSL" : "IO::Socket::INET";
my $port = $ENV{ca_use_ssl} ? 19794 : 19795;
my @pids;
for( 1 .. 5 ) {
if( my $pid = fork ) {
push @pids, $pid;
} else {
print "[$$] start\n";
my $sock = $class->new(PeerAddr=>"localhost:$port", Timeout=>2) or die "couldn't bind: $@";
while( my $line = $sock->getline ) {
print "[$$] $line";
}
my $eof = ($sock->eof() ? "EOF" : "...");
my $ced = ($sock->connected() ? "CONNECTED" : "...");
my $time = time;
print "[$$] time: $time; eof: $eof; ced: $ced\n";
exit 0;
}
}
waitpid( $_, 0 ) for @pids;
Net-IMAP-Simple-1.2209/contrib/status.pl 0000755 0001750 0001750 00000000360 11462543612 017550 0 ustar jettero jettero #!/usr/bin/perl
use strict;
use warnings;
use lib 'inc', "blib/lib", "blib/arch";
use rebuild_iff_necessary;
use slurp_fetchmail;
use Data::Dump qw(dump);
my $imap = slurp_fetchmail->login(use_ssl=>1);
warn dump( $imap->status(shift) );
Net-IMAP-Simple-1.2209/contrib/search-test.pl 0000755 0001750 0001750 00000003262 11462543612 020453 0 ustar jettero jettero #!/usr/bin/perl
use strict;
use Net::IMAP::Simple;
my $goog = login();
$goog->select("jet");
my @id1 = $goog->search(q(SUBJECT "rt.cpan.org #55177")); print "id1: @id1\n";
my @id2 = $goog->search(q(HEADER Message-ID "")); print "id2: @id2\n";
$goog->put( jet => qq(from: jettero\@cpan.org\r\nMessage-ID: test-77\r\nsubject: test-77\r\n\r\ntest-77\r\n) );
$goog->put( jet => qq(from: jettero\@cpan.org\r\nMessage-ID: \r\nsubject: \r\n\r\n\r\n) );
$goog->put( jet => qq(from: jettero\@cpan.org\r\nMessage-ID: \r\nsubject: \r\n\r\n\r\n) );
my @id3 = $goog->search(q(HEADER Message-ID "test-77")); print "id3: @id3\n";
my @id4 = $goog->search(q(HEADER Message-ID "")); print "id4: @id4\n";
my @id5 = $goog->search(q(HEADER Message-ID "")); print "id5: @id5\n";
my @id6 = $goog->search(q(SUBJECT "test-77")); print "id6: @id6\n";
# login {{{
sub login {
my $arg = ""; $arg = ".$_[0]" if $_[0];
my $fetchmailrc; { open my $in, "$ENV{HOME}/.fetchmailrc$arg" or die $!; local $/ = undef; $fetchmailrc = <$in>; close $in; }
my $server = $1 if $fetchmailrc =~ m/server\s+(.+)/m;
my $user = $1 if $fetchmailrc =~ m/user\s+(.+)/m;
my $pass = $1 if $fetchmailrc =~ m/pass\s+(.+)/m;
print "$server ";
my $debug = 1;
my $imap = Net::IMAP::Simple->new($server, debug=>$debug, use_ssl=>1) or die "connect failed: $Net::IMAP::Simple::errstr";
$imap->login($user=>$pass) or die "login failed: " . $imap->errstr;
print "[in] ";
return $imap;
}
# }}}
Net-IMAP-Simple-1.2209/contrib/33189_attach.pl 0000755 0001750 0001750 00000002112 11462543612 020235 0 ustar jettero jettero #!/usr/bin/perl
# Warning: the returned message numbers are not always correct!
use strict;
use warnings;
use Email::Simple;
use lib 'inc', "blib/lib", "blib/arch";
use rebuild_iff_necessary;
use slurp_fetchmail;
use Net::IMAP::Simple;
my $show_subjects = $ENV{SHOW_SUBJECTS};
my $imap = slurp_fetchmail->login(use_ssl=>1);
my $folder = shift || 'INBOX';
my ( $newmsg, $unseenmsg, $oldmsg, $flags );
my $nm = $imap->select($folder);
print "folder $folder: $nm total";
$newmsg = $imap->recent;
$flags = $imap->flags;
$unseenmsg = 0;
for ( my $i = 1 ; $i <= $nm ; $i++ ) {
$unseenmsg++ if not $imap->seen($i);
}
$oldmsg = $unseenmsg - $newmsg;
print ", $newmsg new, $unseenmsg unseen, $oldmsg old\n";
# Print the subjects of all the messages in the INBOX
if ($show_subjects) {
for ( my $i = 1 ; $i <= $nm ; $i++ ) {
if ( $imap->seen($i) ) {
print " ";
} else {
print "N ";
}
my $es = Email::Simple->new( join '', @{ $imap->top($i) } );
printf( "[%03d] %s\n", $i, $es->header('Subject') );
}
}
$imap->quit;
Net-IMAP-Simple-1.2209/contrib/imap.pl 0000755 0001750 0001750 00000005766 11462543612 017172 0 ustar jettero jettero #!/usr/bin/perl
require 'lib/Net/IMAP/Simple.pm';
print "Square brackets: [] indicate optional arguments\n\n";
print "IMAP Server[:port] [localhost]: ";
while(<>){
chomp;
$_ ||= 'localhost';
$imap = Net::IMAP::Simple->new($_, port => 143, timeout => 90) || die "$Net::IMAP::Simple::errstr\n";
if($imap){
print "Connected.\n";
last;
} else {
print "Connection to $_ failed: $Net::IMAP::Simple::errstr\n";
print "IMAP Server[:port]: ";
}
}
print "User: ";
while(<>){
chomp;
$user = $_;
if(!$user){
print "Blank user not allowed\n";
print "User: ";
} else {
last;
}
}
print "Password: ";
system("stty -echo");
while(<>){
chomp;
if(!$imap->login($user, $_)){
print "Login failed: " . $imap->errstr . "\n";
} else {
my $msgs = $imap->select("INBOX");
print "Messages in INBOX: $msgs\n";
last;
}
}
system("stty echo");
print "\n";
my $ptc = qq{
Please enter a command:
help - This help screen
list - List all folders / mail boxes accessable by this account
folders - List all folders within
select box - Select a mail box
select folder - Select a folder within , format: Some.Folder.I.Own
which looks like: Some/Folder/I/Own
exit - Disconnect and close
};
print $ptc . "[root] ";
my %o;
while(<>){
chomp;
my (@folders, %boxes);
my @folders = $imap->mailboxes;
for(@folders){
$boxes{ (split(/\./))[0] } = 1;
}
my @io = split(/\s+/, $_);
if($io[0] eq 'select'){
if($io[1] eq 'box'){
if(!$boxes{ $io[2] }){
print $ptc . "Invalid mail box: $io\n\n";
} else {
print "\n-- Mail box successfully selected --\n $io[2]\n\n";
$o{box} = $io[2];
}
} elsif($io[1] eq 'folder'){
my $c = $imap->select($io[2]);
if(!defined $c){
print $ptc . "Select error: " . $imap->errstr . "\n\n";
} else {
print "-- Folder information: $io[2] --\n";
print " Messages: " . $c . "\n";
print " Recent: " . $imap->recent . "\n";
print " Flags: " . $imap->flags . "\n";
print "Flag List: " . join(" ", $imap->flags) . "\n\n";
# $o{folder} = $io[2];
}
} else {
print $ptc . "Invalid select option\n\n";
}
} elsif($io[0] eq 'list'){
print "-- Avaliable mail folders/boxes --\n";
for(keys %boxes){
print "Mail box: $_\n";
}
print "\n";
} elsif($io[0] eq 'folders' && $o{box}){
print "-- Listing folders in: $o{box} --\n";
my $x = $o{box};
$x =~ s/(\W)/\\$1/g;
for(@folders){
if(/^$x/){
my $msgs = $imap->select($_);
if(!defined $msgs){
print "Failed to read: $o{box} -> $_: " . $imap->errstr . "\n";
} else {
printf("$o{box} -> $_ " . (" " x (30 - length($_))) . "[%06d]\n", $msgs);
}
}
}
print "\n";
} elsif($io[0] eq 'exit' || $io[0] eq 'quit'){
print "Good bye!\n\n";
$imap->quit;
exit;
} elsif($io[0] eq 'help'){
print $ptc;
} else {
print $ptc . "Invalid command: $io[0]\n\n";
}
print "[" . ($o{box} ? $o{box} : 'root') . ($o{folder} ? " -> $o{folder}" : '') . "] ";
}
Net-IMAP-Simple-1.2209/inc/ 0000750 0001750 0001750 00000000000 13117505001 014757 5 ustar jettero jettero Net-IMAP-Simple-1.2209/inc/slurp_fetchmail.pm 0000644 0001750 0001750 00000001742 13116325646 020525 0 ustar jettero jettero
package slurp_fetchmail;
use strict;
use warnings;
use Carp;
use File::Slurp qw(slurp);
use Net::IMAP::Simple;
use File::Basename;
sub login {
my $class = shift;
my $fetchmailrc = slurp("$ENV{HOME}/.fetchmailrc");
my ($server) = $fetchmailrc =~ m/server\s+(.+)/m;
my ($user) = $fetchmailrc =~ m/user\s+(.+)/m;
my ($pass) = $fetchmailrc =~ m/pass\s+(.+)/m;
croak "server, user and pass must be in the $ENV{HOME}/.fetchmailrc for this to work"
unless $server and $user and $pass;
if( exists $ENV{DEBUG} ) {
if( $ENV{DEBUG} eq "1" ) {
$ENV{DEBUG} = basename($0);
$ENV{DEBUG} .= ".log";
}
}
my $imap = Net::IMAP::Simple->new($server,
($ENV{DEBUG} ? (debug=>do { open my $x, ">>", $ENV{DEBUG} or die $!; $x}) : ()),
@_) or croak "connect failed: $Net::IMAP::Simple::errstr";
$imap->login($user=>$pass) or croak "login failed: " . $imap->errstr;
return $imap;
}
"True";
Net-IMAP-Simple-1.2209/inc/rebuild_iff_necessary.pm 0000644 0001750 0001750 00000000327 13116325646 021670 0 ustar jettero jettero
package rebuild_iff_necessary;
BEGIN {
use IPC::System::Simple qw(systemx);
systemx($^X, "Makefile.PL") if not -f "Makefile" or ((stat "Makefile")[9] > (stat "Makefile.PL")[9]);
systemx("make");
}
1;
Net-IMAP-Simple-1.2209/lib/ 0000750 0001750 0001750 00000000000 13117505001 014754 5 ustar jettero jettero Net-IMAP-Simple-1.2209/lib/Net/ 0000750 0001750 0001750 00000000000 13117505001 015502 5 ustar jettero jettero Net-IMAP-Simple-1.2209/lib/Net/IMAP/ 0000750 0001750 0001750 00000000000 13117505001 016230 5 ustar jettero jettero Net-IMAP-Simple-1.2209/lib/Net/IMAP/Simple.pm 0000644 0001750 0001750 00000111236 13117223332 020034 0 ustar jettero jettero package Net::IMAP::Simple;
use strict;
use warnings;
use Carp;
use IO::File;
use IO::Socket;
use IO::Select;
use Net::IMAP::Simple::PipeSocket;
our $VERSION = "1.2209";
BEGIN {
# I'd really rather the pause/cpan indexers miss this "package"
eval ## no critic
q( package Net::IMAP::Simple::_message;
use overload fallback=>1, '""' => sub { local $"=""; "@{$_[0]}" };
sub new { bless $_[1] })
}
our $uidm;
sub new {
my ( $class, $server, %opts ) = @_;
## warn "use of Net::IMAP::Simple::SSL is depricated, pass use_ssl to new() instead\n"
## if $class =~ m/::SSL/;
my $self = bless { count => -1 } => $class;
$self->{use_v6} = ( $opts{use_v6} ? 1 : 0 );
$self->{use_ssl} = ( $opts{use_ssl} ? 1 : 0 );
unless( $opts{shutup_about_v6ssl} ) {
carp "use_ssl with IPv6 is not yet supported"
if $opts{use_v6} and $opts{use_ssl};
}
if( $opts{ssl_version} ) {
$self->{ssl_version} = $opts{ssl_version};
$opts{use_ssl} = 1;
}
$opts{use_ssl} = 1 if $opts{find_ssl_defaults};
if( $opts{use_ssl} ) {
eval {
require IO::Socket::SSL;
import IO::Socket::SSL;
"true";
} or croak "IO::Socket::SSL must be installed in order to use_ssl";
$self->{ssl_options} = [ eval {@{ $opts{ssl_options} }} ];
carp "ignoring ssl_options: $@" if $opts{ssl_options} and not @{ $self->{ssl_options} };
unless( @{ $self->{ssl_options} } ) {
if( $opts{find_ssl_defaults} ) {
my $nothing = 1;
for(qw(
/etc/ssl/certs/ca-certificates.crt
/etc/pki/tls/certs/ca-bundle.crt
/etc/ssl/ca-bundle.pem
/etc/ssl/certs/
)) {
if( -f $_ ) {
@{ $self->{ssl_options} } = (SSL_ca_file=>$_, SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER());
$nothing = 0;
last;
} elsif( -d $_ ) {
@{ $self->{ssl_options} } = (SSL_ca_path=>$_, SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER());
$nothing = 0;
last;
}
}
if( $nothing ) {
carp "couldn't find rational defaults for ssl verify. Choosing to not verify.";
@{ $self->{ssl_options} } = (SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE());
}
} else {
@{ $self->{ssl_options} } = (SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE());
}
}
}
if ( $opts{use_v6} ) {
eval {
require IO::Socket::INET6;
import IO::Socket::INET6;
"true";
} or croak "IO::Socket::INET6 must be installed in order to use_v6";
}
if( $server =~ m/cmd:(.+)/ ) {
$self->{cmd} = $1;
} else {
if( ($self->{server}, $self->{port}) = $server =~ m/^(\d{1,3}(?:\.\d{1,3}){3})(?::(\d+))?\z/ ) {
} elsif( ($self->{server}, $self->{port}) = $server =~ m/^\[([a-fA-F0-9:]+)\]:(\d+)\z/ ) {
} elsif( ($self->{server}, $self->{port}) = $server =~ m/^([a-fA-F0-9:]+)\z/ ) {
} elsif( ($self->{server}, $self->{port}) = $server =~ m/^([^:]+):(\d+)\z/ ) {
} else {
$self->{server} = $server;
$self->{port} = $opts{port};
}
$self->{port} = $self->_port unless defined $self->{port};
}
$self->{timeout} = ( $opts{timeout} ? $opts{timeout} : $self->_timeout );
$self->{retry} = ( defined($opts{retry}) ? $opts{retry} : $self->_retry );
$self->{retry_delay} = ( defined($opts{retry_delay}) ? $opts{retry_delay} : $self->_retry_delay );
$self->{bindaddr} = $opts{bindaddr};
$self->{use_select_cache} = $opts{use_select_cache};
$self->{select_cache_ttl} = $opts{select_cache_ttl};
$self->{debug} = $opts{debug};
$self->{readline_callback} = $opts{readline_callback};
my $sock;
my $c;
for ( my $i = 0 ; $i <= $self->{retry} ; $i++ ) {
if ( $sock = $self->{sock} = $self->_connect ) {
$c = 1;
last;
} elsif ( $i < $self->{retry} ) {
sleep $self->{retry_delay};
# Critic NOTE: I'm not sure why this was done, but it was removed
# beucase the critic said it was bad and sleep makes more sense.
# select( undef, undef, undef, $self->{retry_delay} );
}
}
if ( !$c ) {
$@ =~ s/IO::Socket::INET6?: //g;
$Net::IMAP::Simple::errstr = "connection failed $@";
return;
}
return unless $sock;
my $select = $self->{sel} = IO::Select->new($sock);
$self->_debug( caller, __LINE__, 'new', "waiting for socket ready" ) if $self->{debug};
my $greeting_ok = 0;
if( $select->can_read($self->{timeout}) ) {
$self->_debug( caller, __LINE__, 'new', "looking for greeting" ) if $self->{debug};
if( my $line = $sock->getline ) {
# Cool, we got a line, check to see if it's a
# greeting.
$self->_debug( caller, __LINE__, 'new', "got a greeting: $line" ) if $self->{debug};
$greeting_ok = 1 if $line =~ m/^\*\s+(?:OK|PREAUTH)/i;
# Also, check to see if we failed before we sent any
# commands.
return if $line =~ /^\*\s+(?:NO|BAD)(?:\s+(.+))?/i;
} else {
$self->_debug( caller, __LINE__, 'new', "server hung up during connect" ) if $self->{debug};
# The server hung up on us, otherwise we'd get a line
# after can_read.
return;
}
} else {
$self->_debug( caller, __LINE__, 'new', "no greeting found before timeout" ) if $self->{debug};
}
return unless $greeting_ok;
return $self;
}
sub _connect {
my ($self) = @_;
my $sock;
if( $self->{cmd} ) {
$self->_debug( caller, __LINE__, '_connect', "popping open a pipesocket for command: $self->{cmd}" ) if $self->{debug};
$sock = Net::IMAP::Simple::PipeSocket->new(cmd=>$self->{cmd});
} else {
$self->_debug( caller, __LINE__, '_connect', "connecting to $self->{server}:$self->{port}" ) if $self->{debug};
$sock = $self->_sock_from->new(
PeerAddr => $self->{server},
PeerPort => $self->{port},
Timeout => $self->{timeout},
Proto => 'tcp',
( $self->{bindaddr} ? ( LocalAddr => $self->{bindaddr} ) : () ),
( $_[0]->{ssl_version} ? ( SSL_version => $self->{ssl_version} ) : () ),
( $_[0]->{use_ssl} ? (@{ $self->{ssl_options} }) : () ),
);
}
$self->_debug( caller, __LINE__, '_connect', "connected, returning socket" ) if $self->{debug};
return $sock;
}
sub _port { return $_[0]->{use_ssl} ? 993 : 143 }
sub _sock { return $_[0]->{sock} }
sub _count { return $_[0]->{count} }
sub _last { $_[0]->select unless exists $_[0]->{last}; return $_[0]->{last}||0 }
sub _timeout { return 90 }
sub _retry { return 1 }
sub _retry_delay { return 5 }
sub _sock_from { return $_[0]->{use_v6} ? 'IO::Socket::INET6' : $_[0]->{use_ssl} ? 'IO::Socket::SSL' : 'IO::Socket::INET' }
sub starttls {
my ($self) = @_;
require IO::Socket::SSL; import IO::Socket::SSL;
require Net::SSLeay; import Net::SSLeay;
# $self->{debug} = 1;
# warn "Processing STARTTLS command";
return $self->_process_cmd(
cmd => ['STARTTLS'],
final => sub {
Net::SSLeay::load_error_strings();
Net::SSLeay::SSLeay_add_ssl_algorithms();
Net::SSLeay::randomize();
my $startres = IO::Socket::SSL->start_SSL(
$self->{sock},
SSL_version => $self->{ssl_version} || "SSLv3 TLSv1",
SSL_startHandshake => 0,
);
unless ( $startres ) {
croak "Couldn't start TLS: " . IO::Socket::SSL::errstr() . "\n";
}
$self->_debug( caller, __LINE__, 'starttls', "TLS initialization done" ) if $self->{debug};
1;
},
# process => sub { push @lines, $_[0] if $_[0] =~ /^(?: \s+\S+ | [^:]+: )/x },
);
}
sub login {
my ( $self, $user, $pass ) = @_;
$pass = _escape($pass);
return $self->_process_cmd(
cmd => [ LOGIN => qq[$user $pass] ],
final => sub { 1 },
process => sub { },
);
}
sub separator {
my ( $self, ) = @_;
my $sep;
return $self->_process_cmd (
cmd => [ LIST => qq["" ""] ],
final => sub { $sep },
process => sub { (undef,undef,undef,$sep,undef) = split /\s/smx , $_[0];
$sep =~ s/["]//g; },
);
}
sub _clear_cache {
my $self = shift;
my $cb = $self->current_box;
push @_, $cb if $cb and not @_;
return unless @_;
for my $box (@_) {
delete $self->{BOXES}{$box};
}
delete $self->{last};
return 1;
}
sub uidnext {
my $self = shift;
my $mbox = shift || $self->current_box || "INBOX";
return $self->status($mbox => 'uidnext');
}
sub uidvalidity {
my $self = shift;
my $mbox = shift || $self->current_box || "INBOX";
return $self->status($mbox => 'uidvalidity');
}
sub uidsearch {
my $self = shift;
local $uidm = 1;
return $self->search(@_);
}
sub uid {
my $self = shift;
$self->_be_on_a_box; # does a select if we're not on a mailbox
return $self->uidsearch( shift || "1:*" );
}
sub seq {
my $self = shift;
my $msgno = shift || "1:*";
$self->_be_on_a_box; # does a select if we're not on a mailbox
return $self->search("uid $msgno");
}
sub status {
my $self = shift;
my $mbox = shift || $self->current_box || "INBOX";
my @fields = @_ ? @_ : qw(unseen recent messages);
# Example: C: A042 STATUS blurdybloop (UIDNEXT MESSAGES)
# S: * STATUS blurdybloop (MESSAGES 231 UIDNEXT 44292)
# S: A042 OK STATUS completed
@fields = map{uc$_} @fields;
my %fields;
return $self->_process_cmd(
cmd => [ STATUS => _escape($mbox) . " (@fields)" ],
final => sub { (@fields{@fields}) },
process => sub {
if( my ($status) = $_[0] =~ m/\* STATUS.+?$mbox.+?\((.+?)\)/i ) {
for( @fields ) {
$fields{$_} = _unescape($1)
if $status =~ m/$_\s+(\S+|"[^"]+"|'[^']+')/i
# NOTE: this regex isn't perfect, but should almost always work
# for status values returned by a well meaning IMAP server
}
}
},
);
}
sub select { ## no critic -- too late to choose a different name now...
my ( $self, $mbox, $examine_mode ) = @_;
$examine_mode = $examine_mode ? 1:0;
$self->{examine_mode} = 0 unless exists $self->{examine_mode};
$mbox = $self->current_box unless $mbox;
if( $examine_mode == $self->{examine_mode} ) {
if ( $self->{use_select_cache} && ( time - $self->{BOXES}{$mbox}{proc_time} ) <= $self->{select_cache_ttl} ) {
return $self->{BOXES}{$mbox}{messages};
}
}
$self->{BOXES}{$mbox}{proc_time} = time;
my $cmd = $examine_mode ? 'EXAMINE' : 'SELECT';
return $self->_process_cmd(
cmd => [ $cmd => _escape($mbox) ],
final => sub {
my $nm = $self->{last} = $self->{BOXES}{$mbox}{messages};
$self->{working_box} = $mbox;
$self->{examine_mode} = $examine_mode;
$nm ? $nm : "0E0";
},
process => sub {
if ( $_[0] =~ /^\*\s+(\d+)\s+EXISTS/i ) {
$self->{BOXES}{$mbox}{messages} = $1;
} elsif ( $_[0] =~ /^\*\s+FLAGS\s+\((.*?)\)/i ) {
$self->{BOXES}{$mbox}{flags} = [ split( /\s+/, $1 ) ];
} elsif ( $_[0] =~ /^\*\s+(\d+)\s+RECENT/i ) {
$self->{BOXES}{$mbox}{recent} = $1;
} elsif ( $_[0] =~ /^\*\s+OK\s+\[(.*?)\s+(.*?)\]/i ) {
my ( $flag, $value ) = ( $1, $2 );
if ( $value =~ /\((.*?)\)/ ) {
# NOTE: the sflags really aren't used anywhere, should they be?
$self->{BOXES}{$mbox}{sflags}{$flag} = [ split( /\s+/, $1 ) ];
} else {
$self->{BOXES}{$mbox}{oflags}{$flag} = $value;
}
}
},
);
}
sub examine {
my $self = shift;
return $self->select($_[0], 1);
}
sub messages {
my ( $self, $folder ) = @_;
return $self->select($folder);
}
sub flags {
my ( $self, $folder ) = @_;
$self->select($folder);
return @{ $self->{BOXES}{ $self->current_box }{flags} || [] };
}
sub recent {
my ( $self, $folder ) = @_;
$self->select($folder);
return $self->{BOXES}{ $self->current_box }{recent};
}
sub unseen {
my ( $self, $folder ) = @_;
my $oflags = $self->{BOXES}{ $self->current_box }{oflags};
if( exists $oflags->{UNSEEN} ) {
$self->select($folder);
return $self->{BOXES}{ $self->current_box }{oflags}{UNSEEN};
}
my ($unseen) = $self->status;
return $unseen;
}
sub current_box {
my ($self) = @_;
return ( $self->{working_box} ? $self->{working_box} : 'INBOX' );
}
sub close { ## no critic -- we already have tons of methods with built in names
my $self = shift;
$self->{working_box} = undef;
return $self->_process_cmd(
cmd => [ "CLOSE" ],
);
}
sub noop {
my $self = shift;
return $self->_process_cmd(
cmd => [ "NOOP" ],
);
}
sub top {
my ( $self, $number ) = @_;
my $messages = $number || '1:' . $self->_last;
my @lines;
## rfc2822 ## 2.2. Header Fields
## rfc2822 ## Header fields are lines composed of a field name, followed by a colon
## rfc2822 ## (":"), followed by a field body, and terminated by CRLF. A field
## rfc2822 ## name MUST be composed of printable US-ASCII characters (i.e.,
## rfc2822 ## characters that have values between 33 and 126, inclusive), except
## rfc2822 ## colon. A field body may be composed of any US-ASCII characters,
## rfc2822 ## except for CR and LF. However, a field body may contain CRLF when
## rfc2822 ## used in header "folding" and "unfolding" as described in section
## rfc2822 ## 2.2.3. All field bodies MUST conform to the syntax described in
## rfc2822 ## sections 3 and 4 of this standard.
return $self->_process_cmd(
cmd => [ FETCH => qq[$messages RFC822.HEADER] ],
final => sub {
$lines[-1] =~ s/\)\x0d\x0a\z// # sometimes we get this and I don't think we should
# I really hoping I'm not breaking someting by doing this.
if @lines;
return wantarray ? @lines : \@lines
},
process => sub {
return if $_[0] =~ m/\*\s+\d+\s+FETCH/i; # should this really be case insensitive?
if( not @lines or $_[0] =~ m/^[!-9;-~]+:/ ) {
push @lines, $_[0];
} else {
$lines[-1] .= $_[0];
}
},
);
}
sub seen {
my ( $self, $number ) = @_;
my @flags = $self->msg_flags($number);
return if $self->waserr;
return 1 if grep {$_ eq '\Seen'} @flags;
return 0;
}
sub deleted {
my ( $self, $number ) = @_;
my @flags = $self->msg_flags($number);
return if $self->waserr;
return 1 if grep {$_ eq '\Deleted'} @flags;
return 0;
}
sub range2list {
my $self_or_class = shift;
my %h;
my @items = grep {!$h{$_}++} map { m/(\d+):(\d+)/ ? ($1 .. $2) : ($_) } split(m/[,\s]+/, shift);
return @items;
}
sub list2range {
my $self_or_class = shift;
my %h;
my @a = sort { $a<=>$b } grep {!$h{$_}++} grep {m/^\d+/} grep {defined $_} @_;
my @b;
while(@a) {
my $e = 0;
$e++ while $e+1 < @a and $a[$e]+1 == $a[$e+1];
push @b, ($e>0 ? [$a[0], $a[$e]] : [$a[0]]);
splice @a, 0, $e+1;
}
return join(",", map {join(":", @$_)} @b);
}
sub list {
my ( $self, $number ) = @_;
# NOTE: this entire function is horrible:
# 1. it should be called message_size() or something similar
# 2. what if $number is a range? none of this works right
my $messages = $number || '1:' . $self->_last;
my %list;
return {} if $messages eq "1:0";
return $self->_process_cmd(
cmd => [ FETCH => qq[$messages RFC822.SIZE] ],
final => sub { $number ? $list{$number} : \%list },
process => sub {
if ( $_[0] =~ /^\*\s+(\d+).*RFC822.SIZE\s+(\d+)/i ) {
$list{$1} = $2;
}
},
);
}
sub search {
my ($self, $search, $sort, $charset) = @_;
$search ||= "ALL";
$charset ||= 'UTF-8';
my $cmd = $uidm ? 'UID SEARCH' : 'SEARCH';
$self->_be_on_a_box; # does a select if we're not on a mailbox
# add rfc5256 sort, requires charset :(
if ($sort) {
$sort = uc $sort;
$cmd = ($uidm ? "UID ": "") . "SORT ($sort) \"$charset\"";
}
my @seq;
return $self->_process_cmd(
cmd => [ $cmd => $search ],
final => sub { wantarray ? @seq : int @seq },
process => sub { if ( my ($msgs) = $_[0] =~ /^\*\s+(?:SEARCH|SORT)\s+(.*)/i ) {
@seq = $self->range2list($msgs);
}},
);
}
sub search_seen { my $self = shift; return $self->search("SEEN"); }
sub search_recent { my $self = shift; return $self->search("RECENT"); }
sub search_answered { my $self = shift; return $self->search("ANSWERED"); }
sub search_deleted { my $self = shift; return $self->search("DELETED"); }
sub search_flagged { my $self = shift; return $self->search("FLAGGED"); }
sub search_draft { my $self = shift; return $self->search("FLAGGED"); }
sub search_unseen { my $self = shift; return $self->search("UNSEEN"); }
sub search_old { my $self = shift; return $self->search("OLD"); }
sub search_unanswered { my $self = shift; return $self->search("UNANSWERED"); }
sub search_undeleted { my $self = shift; return $self->search("UNDELETED"); }
sub search_unflagged { my $self = shift; return $self->search("UNFLAGGED"); }
sub search_smaller { my $self = shift; my $octets = int shift; return $self->search("SMALLER $octets"); }
sub search_larger { my $self = shift; my $octets = int shift; return $self->search("LARGER $octets"); }
sub _process_date {
my $d = shift;
if( eval 'use Date::Manip (); 1' ) { ## no critic
if( my $pd = Date::Manip::ParseDate($d) ) {
# NOTE: RFC 3501 wants this poorly-internationalized date format
# for SEARCH. Not my fault.
return Date::Manip::UnixDate($pd, '%d-%b-%Y');
}
} else {
# TODO: complain if the date isn't %d-%m-%Y
# I'm not sure there's anything to be gained by doing so ... They'll
# just get an imap error they can choose to handle.
}
return $d;
}
sub _process_qstring {
my $t = shift;
$t =~ s/\\/\\\\/g;
$t =~ s/"/\\"/g;
return "\"$t\"";
}
sub search_before { my $self = shift; my $d = _process_date(shift); return $self->search("BEFORE $d"); }
sub search_since { my $self = shift; my $d = _process_date(shift); return $self->search("SINCE $d"); }
sub search_sent_before { my $self = shift; my $d = _process_date(shift); return $self->search("SENTBEFORE $d"); }
sub search_sent_since { my $self = shift; my $d = _process_date(shift); return $self->search("SENTSINCE $d"); }
sub search_from { my $self = shift; my $t = _process_qstring(shift); return $self->search("FROM $t"); }
sub search_to { my $self = shift; my $t = _process_qstring(shift); return $self->search("TO $t"); }
sub search_cc { my $self = shift; my $t = _process_qstring(shift); return $self->search("CC $t"); }
sub search_bcc { my $self = shift; my $t = _process_qstring(shift); return $self->search("BCC $t"); }
sub search_subject { my $self = shift; my $t = _process_qstring(shift); return $self->search("SUBJECT $t"); }
sub search_body { my $self = shift; my $t = _process_qstring(shift); return $self->search("BODY $t"); }
sub get {
my ( $self, $number, $part ) = @_;
my $arg = $part ? "BODY[$part]" : 'RFC822';
return $self->fetch( $number, $part );
}
sub fetch {
my ( $self, $number, $part ) = @_;
my $arg = $part || 'RFC822';
my @lines;
my $fetching;
return $self->_process_cmd(
cmd => [ FETCH => qq[$number $arg] ],
final => sub {
if( $fetching ) {
if( $fetching > 0 ) {
# XXX: this is just about the least efficient way in the
# world to do this; I should appologize, but really,
# nothing in this module is done particularly well. I
# doubt anyone will notice this.
local $"="";
my $message = "@lines";
@lines = split m/(?<=\x0d\x0a)/, substr($message, 0, $fetching)
if( length $message > $fetching );
}
return wantarray ? @lines : Net::IMAP::Simple::_message->new(\@lines)
}
if( defined $fetching and $fetching == 0 ) {
return "\n"; # XXX: Your 0 byte message is incorrectly returned as a newline. Meh.
}
# NOTE: There is not supposed to be an error if you ask for a
# message that's not there, but this is a rather confusing
# notion … so we generate an error here.
$self->{_errstr} = "message not found";
return;
},
process => sub {
if ( $_[0] =~ /^\*\s+\d+\s+FETCH\s+\(.+?\{(\d+)\}/ ) {
$fetching = $1;
} elsif( $_[0] =~ /^\*\s+\d+\s+FETCH\s+\(.+?\"(.*)\"\s*\)/ ) {
# XXX: this is not tested because Net::IMAP::Server doesn't do
# this type of string result (that I know of) for this it might
# work, ... frog knows. Not likely to come up very often, if
# ever; although you do sometimes see the occasional 0byte
# message. Valid really.
$fetching = -1;
@lines = ($1);
} elsif( $fetching ) {
push @lines, join( ' ', @_ );
}
},
);
}
sub _process_flags {
my $self = shift;
my @ret = map { split m/\s+/, $_ } grep { $_ } @_;
return @ret;
}
sub put {
my ( $self, $mailbox_name, $msg, @flags ) = @_;
croak "usage: \$imap->put(mailbox, message, \@flags)" unless defined $msg and defined $mailbox_name;
my $size = length $msg;
if ( ref $msg eq "ARRAY" ) {
$size = 0;
$size += length $_ for @$msg;
}
@flags = $self->_process_flags(@flags);
return $self->_process_cmd(
cmd => [ APPEND => _escape($mailbox_name) ." (@flags) {$size}" ],
final => sub { $self->_clear_cache; 1 },
process => sub {
if( $_[0] =~ m/^\+\s+/ ) { # + continue (or go ahead, or whatever)
if ($size) {
my $sock = $self->_sock;
if ( ref $msg eq "ARRAY" ) {
print $sock $_ for @$msg;
} else {
print $sock $msg;
}
$size = undef;
print $sock "\r\n";
}
}
},
);
}
# This supports supplying a date per IMAP RFC 3501
# APPEND Command - Section 6.3.11
# Implemented here as a new method so when calling the put above
# older code will not break
sub put_with_date {
my ( $self, $mailbox_name, $msg, $date, @flags ) = @_;
croak "usage: \$imap->put_with_date(mailbox, message, date, \@flags)" unless defined $msg and defined $mailbox_name;
my $size = length $msg;
if ( ref $msg eq "ARRAY" ) {
$size = 0;
$size += length $_ for @$msg;
}
@flags = $self->_process_flags(@flags);
my $cmd_str = _escape($mailbox_name) . " (@flags)";
$cmd_str .= " " . _escape($date) if $date ne "";
$cmd_str .= " {$size}";
return $self->_process_cmd(
cmd => [ APPEND => $cmd_str ],
final => sub { $self->_clear_cache; 1 },
process => sub {
if( $_[0] =~ m/^\+\s+/ ) { # + continue (or go ahead, or whatever)
if ($size) {
my $sock = $self->_sock;
if ( ref $msg eq "ARRAY" ) {
print $sock $_ for @$msg;
} else {
print $sock $msg;
}
$size = undef;
print $sock "\r\n";
}
}
},
);
}
sub msg_flags {
my ( $self, $number ) = @_;
my @flags;
$self->{_waserr} = 1; # assume something went wrong.
$self->{_errstr} = "flags not found during fetch";
# _send_cmd] 15 FETCH 12 (FLAGS)\r\n
# _process_cmd] * 12 FETCH (FLAGS (\Seen))\r\n
# _cmd_ok] * 12 FETCH (FLAGS (\Seen))\r\n
# _seterrstr] warning unknown return string (id=15): * 12 FETCH (FLAGS (\Seen))\r\n
# _process_cmd] 15 OK Success\r\n
return $self->_process_cmd(
cmd => [ FETCH => qq[$number (FLAGS)] ],
final => sub {
return if $self->{_waserr};
wantarray ? @flags : "@flags";
},
process => sub {
if( $_[0] =~ m/\* $number FETCH \(FLAGS \(([^()]*?)\)\)/i ) {
@flags = $self->_process_flags($1);
delete $self->{_waserr};
}
},
);
}
sub getfh {
my ( $self, $number ) = @_;
my $file = IO::File->new_tmpfile;
my $buffer;
return $self->_process_cmd(
cmd => [ FETCH => qq[$number RFC822] ],
final => sub { seek $file, 0, 0; $file },
process => sub {
if ( $_[0] !~ /^\* \d+ FETCH/ ) {
defined($buffer) and print $file $buffer;
$buffer = $_[0];
}
},
);
}
sub logout {
my $self = shift;
return $self->_process_cmd( cmd => ['LOGOUT'], final => sub { $self->_sock->close; 1 }, process => sub { } );
}
sub quit {
my ( $self, $hq ) = @_;
$self->_send_cmd('EXPUNGE'); # XXX: $self->expunge_mailbox?
if ( !$hq ) {
# XXX: $self->logout?
$self->_process_cmd( cmd => ['LOGOUT'], final => sub { 1 }, process => sub { } );
} else {
# XXX: do people use the $hq?
$self->_send_cmd('LOGOUT');
}
$self->_sock->close;
return 1;
}
sub _be_on_a_box {
my $self = shift;
return if $self->{working_box};
$self->select; # sit on something
return;
}
sub last { ## no critic -- too late to choose a different name now...
my $self = shift;
my $last = $self->_last;
if( not defined $last ) {
$self->select or return;
$last = $self->_last;
}
return $last;
}
sub add_flags {
my ( $self, $number, @flags ) = @_;
@flags = $self->_process_flags(@flags);
return unless @flags;
return $self->_process_cmd(
cmd => [ STORE => qq[$number +FLAGS (@flags)] ],
final => sub { $self->_clear_cache },
process => sub { },
);
}
sub sub_flags {
my ( $self, $number, @flags ) = @_;
@flags = $self->_process_flags(@flags);
return unless @flags;
return $self->_process_cmd(
cmd => [ STORE => qq[$number -FLAGS (@flags)] ],
final => sub { $self->_clear_cache },
process => sub { },
);
}
sub delete { ## no critic -- too late to choose a different name now...
my ( $self, $number ) = @_;
return $self->add_flags( $number, '\Deleted' );
}
sub undelete {
my ( $self, $number ) = @_;
return $self->sub_flags( $number, '\Deleted' );
}
sub see {
my ( $self, $number ) = @_;
return $self->add_flags( $number, '\Seen' );
}
sub unsee {
my ( $self, $number ) = @_;
return $self->sub_flags( $number, '\Seen' );
}
sub _process_list {
my ( $self, $line ) = @_;
$self->_debug( caller, __LINE__, '_process_list', $line ) if $self->{debug};
my @list;
if ( $line =~ /^\*\s+(LIST|LSUB).*\s+\{\d+\}\s*$/i ) {
chomp( my $res = $self->_sock->getline );
$res =~ s/\r//;
push @list, _escape($res);
$self->_debug( caller, __LINE__, '_process_list', $res ) if $self->{debug};
} elsif ( $line =~ /^\*\s+(LIST|LSUB).*\s+(\".*?\")\s*$/i || $line =~ /^\*\s+(LIST|LSUB).*\s+(\S+)\s*$/i ) {
push @list, $2;
}
return @list;
}
sub mailboxes {
my ( $self, $box, $ref ) = @_;
$ref ||= '""';
my @list;
if ( !defined $box ) {
# recurse, should probably follow
# RFC 2683: 3.2.1.1. Listing Mailboxes
return $self->_process_cmd(
cmd => [ LIST => qq[$ref *] ],
final => sub { map { _unescape($_) } @list },
process => sub { push @list, $self->_process_list( $_[0] ); },
);
}
return $self->_process_cmd(
cmd => [ LIST => qq[$ref $box] ],
final => sub { map { _unescape($_) } @list },
process => sub { push @list, $self->_process_list( $_[0] ) },
);
}
sub mailboxes_subscribed {
my ( $self, $box, $ref ) = @_;
$ref ||= '""';
my @list;
if ( !defined $box ) {
# recurse, should probably follow
# RFC 2683: 3.2.2. Subscriptions
return $self->_process_cmd(
cmd => [ LSUB => qq[$ref *] ],
final => sub { map { _unescape($_) } @list },
process => sub { push @list, $self->_process_list( $_[0] ) },
);
}
return $self->_process_cmd(
cmd => [ LSUB => qq[$ref $box] ],
final => sub { map { _unescape($_) } @list },
process => sub { push @list, $self->_process_list( $_[0] ) },
);
}
sub create_mailbox {
my ( $self, $box ) = @_;
return $self->_process_cmd(
cmd => [ CREATE => _escape($box) ],
final => sub { 1 },
process => sub { },
);
}
sub expunge_mailbox {
my ( $self, $box ) = @_;
return if !$self->select($box);
# C: A202 EXPUNGE
# S: * 3 EXPUNGE
# S: * 3 EXPUNGE
# S: * 5 EXPUNGE
# S: * 8 EXPUNGE
# S: A202 OK EXPUNGE completed
my @expunged;
return $self->_process_cmd(
cmd => ['EXPUNGE'],
final => sub {
$self->_clear_cache;
return @expunged if wantarray; # don't return 0E0 if want array and we're empty
return "0E0" unless @expunged;
return @expunged;
},
process => sub {
if( $_[0] =~ m/^\s*\*\s+(\d+)\s+EXPUNGE[\r\n]*$/i ) {
push @expunged, $1;
}
},
);
}
sub delete_mailbox {
my ( $self, $box ) = @_;
return $self->_process_cmd(
cmd => [ DELETE => _escape($box) ],
final => sub { 1 },
process => sub { },
);
}
sub rename_mailbox {
my ( $self, $old_box, $new_box ) = @_;
my $o = _escape($old_box);
my $n = _escape($new_box);
return $self->_process_cmd(
cmd => [ RENAME => qq[$o $n] ],
final => sub { 1 },
process => sub { },
);
}
sub folder_subscribe {
my ( $self, $box ) = @_;
$self->select($box);
return $self->_process_cmd(
cmd => [ SUBSCRIBE => _escape($box) ],
final => sub { 1 },
process => sub { },
);
}
sub folder_unsubscribe {
my ( $self, $box ) = @_;
$self->select($box);
return $self->_process_cmd(
cmd => [ UNSUBSCRIBE => _escape($box) ],
final => sub { 1 },
process => sub { },
);
}
sub copy {
my ( $self, $number, $box ) = @_;
my $b = _escape($box);
return $self->_process_cmd(
cmd => [ COPY => qq[$number $b] ],
final => sub { 1 },
process => sub { },
);
}
sub uidcopy {
my ( $self, $number, $box ) = @_;
my $b = _escape($box);
return $self->_process_cmd(
cmd => [ 'UID COPY' => qq[$number $b] ],
final => sub { 1 },
process => sub { },
);
}
sub waserr {
return $_[0]->{_waserr};
}
sub errstr {
return $_[0]->{_errstr};
}
sub _nextid { return ++$_[0]->{count} }
sub _escape {
my $val = shift;
$val =~ s/\\/\\\\/g;
$val =~ s/\"/\\\"/g;
$val = "\"$val\"";
return $val;
}
sub _unescape {
my $val = shift;
$val =~ s/^"//g;
$val =~ s/"$//g;
$val =~ s/\\\"/\"/g;
$val =~ s/\\\\/\\/g;
return $val;
}
sub _send_cmd {
my ( $self, $name, $value ) = @_;
my $sock = $self->_sock;
my $id = $self->_nextid;
my $cmd = "$id $name" . ( $value ? " $value" : "" ) . "\r\n";
$self->_debug( caller, __LINE__, '_send_cmd', $cmd ) if $self->{debug};
{ local $\; print $sock $cmd; }
return ( $sock => $id );
}
sub _cmd_ok {
my ( $self, $res ) = @_;
my $id = $self->_count;
$self->_debug( caller, __LINE__, '_cmd_ok', $res ) if $self->{debug};
if ( $res =~ /^$id\s+OK/i ) {
return 1;
} elsif ( $res =~ /^$id\s+(?:NO|BAD)(?:\s+(.+))?/i ) {
$self->_seterrstr( $1 || 'unknown error' );
return 0;
} elsif ( $res =~ m/^\*\s+/ ) {
} else {
$self->_seterrstr("warning unknown return string (id=$id): $res");
}
return;
}
sub _read_multiline {
my ( $self, $sock, $list, $count ) = @_;
my @lines;
my $read_so_far = 0;
while ( $read_so_far < $count ) {
if( defined( my $line = $sock->getline ) ) {
$read_so_far += length( $line );
push @lines, $line;
} else {
$self->_seterrstr( "error reading $count bytes from socket" );
last;
}
}
if( $list and $lines[-1] !~ m/\)[\x0d\x0a\s]*$/ ) {
$self->_debug( caller, __LINE__, '_read_multiline', "Looking for ending parenthesis match..." ) if $self->{debug};
my $unmatched = 1;
while( $unmatched ) {
if( defined( my $line = $sock->getline ) ) {
push @lines, $line;
$unmatched = 0 if $line =~ m/\)[\x0d\x0a\s]*$/;
} else {
$self->_seterrstr( "error reading $count bytes from socket" );
last;
}
}
}
if ( $self->{debug} ) {
my $count=0;
for ( my $i = 0 ; $i < @lines ; $i++ ) {
$count += length($lines[$i]);
$self->_debug( caller, __LINE__, '_read_multiline', "[$i] ($count) $lines[$i]" );
}
}
return @lines;
}
sub _process_cmd {
my ( $self, %args ) = @_;
my ( $sock, $id ) = $self->_send_cmd( @{ $args{cmd} } );
$args{process} = sub {} unless ref($args{process}) eq "CODE";
$args{final} = sub {} unless ref($args{final}) eq "CODE";
my $cb = $self->{readline_callback};
my $res;
while ( $res = $sock->getline ) {
$cb->($res) if $cb;
$self->_debug( caller, __LINE__, '_process_cmd', $res ) if $self->{debug};
if ( $res =~ /^\*.*\{(\d+)\}[\r\n]*$/ ) {
my $count = $1;
my $list;
$list = 1 if($res =~ /\(/);
$args{process}->($res);
foreach( $self->_read_multiline( $sock, $list, $count ) ) {
$cb->($_) if $cb;
$args{process}->($_)
}
} else {
my $ok = $self->_cmd_ok($res);
if ( defined($ok) && $ok == 1 ) {
return $args{final}->($res);
} elsif ( defined($ok) && !$ok ) {
return;
} else {
$args{process}->($res);
}
}
}
return;
}
sub _seterrstr {
my ( $self, $err ) = @_;
$self->{_errstr} = $err;
$self->_debug( caller, __LINE__, '_seterrstr', $err ) if $self->{debug};
return;
}
sub debug {
my $this = shift;
if( @_ ) {
$this->{debug} = shift;
}
return $this->{debug};
}
sub _debug {
my ( $self, $package, $filename, $line, $dline, $routine, $str ) = @_;
$str =~ s/\n/\\n/g;
$str =~ s/\r/\\r/g;
$str =~ s/\cM/^M/g;
my $shortness = 30;
my $elipsissn = $shortness-3;
my $flen = length $filename;
my $short_fname = ($flen > $shortness ? "..." . substr($filename, $flen - $elipsissn) : $filename);
$line = "[$short_fname line $line in sub $routine] $str\n";
if( exists $self->{debug} and defined $self->{debug} ) {
if ( ref( $self->{debug} ) eq 'GLOB' ) {
print { $self->{debug} } $line;
} elsif( $self->{debug} eq "warn" ) {
warn $line;
} elsif( $self->{debug} =~ m/^file:(.+)/ ) {
open my $out, ">>", $1 or warn "[log io fail: $@] $line";
print $out $line;
CORE::close($out);
} else {
print STDOUT $line;
}
}
return;
}
1;
Net-IMAP-Simple-1.2209/lib/Net/IMAP/SimpleX.pod 0000644 0001750 0001750 00000013050 13117223063 020326 0 ustar jettero jettero =head1 NAME
Net::IMAP::SimpleX - Addons for Net::IMAP::Simple
=head1 SYNOPSIS
use strict;
use warnings;
use Net::IMAP::SimpleX;
L uses L as a base so the object creation
is the same as it is for the ancestor:
my $imap = Net::IMAP::SimpleX->new('imap.example.com') ||
die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";
$imap->select("INBOX");
L is a collection of handy methods that are
not simple, require L, or are experimental.
=head1 DESCRIPTION
This module adds some useful, yet not so simple, extensions on top of
L.
=head1 METHODS
=over 4
=item new
For details on the invocation, read L.
=item body_summary
Typical invocations will take this overall shape.
# get an object representation of the message body
my $summary = $imap->body_summary($message_number);
# multipart message
if ($summary->has_parts) {
for my $subpart ($summary->parts) {
if ($subpart->has_parts) { ... }
# examine the message part
my @attr = map { $subpart->$_ } qw/content_type encoding encoded_size/;
# fetch the raw message part
my $subpart_body = $imap->get($message_number, $subpart->part_number);
}
} else {
my $body = $summary->body;
my @attr = map { $body->$_ } qw/content_type encoding encoded_size/
}
This method returns a simple object that contains a representation of the body
of a message. The object is built by a L parser using the
output of an IMAP I command. The parser uses the formal syntax as
defined by RFC3501 L.
my $body = $summary->body;
my @attr = map { $body->$_ } qw/
content_description
encoded_size
charset
content_type
part_number
format
id
encoding
/;
For multipart messages, the object contains sub-objects for each message part,
accessible via the parts() method and inspected via the has_parts() method.
The type method describes the type of multipart (such as mixed or alternative).
The parts method returns a list of sub parts, which themselves may have
subparts, and so on.
An example of a multipart, alternative message with a text body and an html
version of the body would looke something like:
if ($summary->has_parts) {
if ($summary->type eq 'alternative') {
my ($html) = grep { $_->content_type eq 'text/html' } $summary->parts;
}
}
A really complex, multipart message could look something like this:
if ($summary->has_parts && $summary->type eq 'mixed') {
for my $part ($summary->parts) {
if ($part->has_parts && $part->type eq 'mixed') { ... }
...
}
}
=item fetch
The fetch command returns the various parts of messages that users request. It
is fairly complicated (following RFC3501 using a grammar/parser), but there are
some basic patterns that it follows.
my $res =$imap->fetch('30:32' => 'UID BODY.PEEK[HEADER.FIELDS (DATE)] FLAGS')
# $res = {
# 30 => {
# "BODY[HEADER.FIELDS (DATE)]" => "Date: Sun, 18 Jul 2010 20:54:48 -0400\r\n\r\n",
# "FLAGS" => ["\\Flagged", "\\Seen"],
# "UID" => 58890,
# },
# 31 => {
# "BODY[HEADER.FIELDS (DATE)]" => "Date: Wed, 21 Jul 2010 09:09:04 -0400\r\n\r\n",
# "FLAGS" => ["\\Seen"],
# "UID" => 58891,
# },
# 32 => {
# "BODY[HEADER.FIELDS (DATE)]" => "Date: Sat, 24 Jul 2010 05:12:06 -0700\r\n\r\n",
# "FLAGS" => ["\\Seen"],
# "UID" => 58892,
# },
# }
So-called "parenthized" lists will be returned as an array (see C) but
nearly everything else will come back as strings. This includes parenthized
queries. Take C), for example.
The result would come back as the RFC822 header lines (as the above C has done).
For more information about the different types of queries, see RFC3501. There's
a surprising number of things that can be queried.
=item uidfetch
This is roughly the same thing as the C method above, but the query
runs on UIDs instead of sequence numbers. The keys of the C<$res> are still the
sequence numbers though.
my $res =$imap->fetch('58890' => 'UID BODY.PEEK[HEADER.FIELDS (DATE)] FLAGS')
# $res = {
# 30 => {
# "BODY[HEADER.FIELDS (DATE)]" => "Date: Sun, 18 Jul 2010 20:54:48 -0400\r\n\r\n",
# "FLAGS" => ["\\Flagged", "\\Seen"],
# "UID" => 58890,
# },
# ...
=back
=head1 AUTHOR
=over 4
=item INITIAL AUTHOR
Jason Woodward C<< >>
=item ADDITIONAL CONTRIBUTIONS
Paul Miller C<< >> [I]
=back
=head1 COPYRIGHT
Copyright (c) 2010 Jason Woodward
All rights reserved. This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
=head1 LICENSE
This module is free software. You can redistribute it and/or
modify it under the terms of the Artistic License 2.0.
This program is distributed in the hope that it will be useful,
but without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.
=head1 BUGS
L
=head1 SEE ALSO
L, L, L
Net-IMAP-Simple-1.2209/lib/Net/IMAP/Simple.pod 0000644 0001750 0001750 00000076747 13117223334 020225 0 ustar jettero jettero =encoding utf-8
=head1 NAME
Net::IMAP::Simple - Perl extension for simple IMAP account handling.
=head1 SYNOPSIS
use strict;
use warnings;
use Net::IMAP::Simple;
use Email::Simple;
# Create the object
my $imap = Net::IMAP::Simple->new('imap.example.com') ||
die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";
# Log on
if(!$imap->login('user','pass')){
print STDERR "Login failed: " . $imap->errstr . "\n";
exit(64);
}
# Print the subject's of all the messages in the INBOX
my $nm = $imap->select('INBOX');
for(my $i = 1; $i <= $nm; $i++){
if($imap->seen($i)){
print "*";
} else {
print " ";
}
my $es = Email::Simple->new(join '', @{ $imap->top($i) } );
printf("[%03d] %s\n", $i, $es->header('Subject'));
}
$imap->quit;
=head1 DESCRIPTION
This module is a simple way to access IMAP accounts.
=head1 OBJECT CREATION METHOD
my $imap = Net::IMAP::Simple->new( $server [ :port ]);
# OR
my $imap = Net::IMAP::Simple->new( $server [, option_name => option_value ] );
=head2 new
This class method constructs a new L object. It takes one
required parameter which is the server to connect to, and additional optional
parameters.
The server parameter may specify just the server, or both the server and port
number. To specify an alternate port, separate it from the server with a colon
(C<:>), C.
On success an object is returned. On failure, nothing is returned and an error
message is set to C<$Net::IMAP::Simple>.
See L below for a special hostname invocation that doesn't use Sockets
(internally).
Options are provided as a hash to C:
=over 4
=item port => int
Assign the port number (default: 143)
=item timeout => int (default: 90)
Connection timeout in seconds.
=item retry => int (default: 1)
Attempt to retry the connection attmpt (x) times before giving up
=item retry_delay => int (default: 5)
Wait (x) seconds before retrying a connection attempt
=item use_v6 => BOOL
If set to true, attempt to use IPv6 sockets rather than IPv4 sockets.
This option requires the L module
=item use_ssl => BOOL
If set to true, attempt to use L sockets rather than vanilla sockets.
Note that no attempt is made to check the certificate validity by default. This
is terrible personal security but matches the previous behavior of this module.
Please consider using C below.
This option requires the L module
=item ssl_version => version
This should be one or more of the following (space separated): SSLv3 SSLv2
TLSv1. If you specify, for example, "SSLv3 SSLv2" then L will
attempt auto negotiation. At the time of this writing, the default string was
v3/v2 auto negotiation -- it may have changed by the time you read this.
Warning: setting this will also set C.
=item find_ssl_defaults => []
Looks in some standard places for CA certificate libraries and if found sets
reasonable defaults along the lines of the following.
ssl_options => [ SSL_ca_path => "/etc/ssl/certs/",
SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER() ]
Warning: setting this will also set C.
=item ssl_options => []
You may provide your own L options if you desire to do so.
It is completely overridden by C above.
=item bindaddr => str
Assign a local address to bind
=item use_select_cache => BOOL
Enable C