r47485 - in /branches/upstream/libnet-imap-simple-perl/current: Changes MANIFEST META.yml Simple.pm Simple.pod TODO t/45_search.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Thu Nov 19 17:16:30 UTC 2009
Author: jawnsy-guest
Date: Thu Nov 19 17:16:25 2009
New Revision: 47485
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=47485
Log:
[svn-upgrade] Integrating new upstream version, libnet-imap-simple-perl (1.1910)
Added:
branches/upstream/libnet-imap-simple-perl/current/TODO
branches/upstream/libnet-imap-simple-perl/current/t/45_search.t
Modified:
branches/upstream/libnet-imap-simple-perl/current/Changes
branches/upstream/libnet-imap-simple-perl/current/MANIFEST
branches/upstream/libnet-imap-simple-perl/current/META.yml
branches/upstream/libnet-imap-simple-perl/current/Simple.pm
branches/upstream/libnet-imap-simple-perl/current/Simple.pod
Modified: branches/upstream/libnet-imap-simple-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-imap-simple-perl/current/Changes?rev=47485&op=diff
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/Changes (original)
+++ branches/upstream/libnet-imap-simple-perl/current/Changes Thu Nov 19 17:16:25 2009
@@ -1,3 +1,25 @@
+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:
+ <blarg-blarg.blarg>
+
+ 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
Modified: branches/upstream/libnet-imap-simple-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-imap-simple-perl/current/MANIFEST?rev=47485&op=diff
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/MANIFEST (original)
+++ branches/upstream/libnet-imap-simple-perl/current/MANIFEST Thu Nov 19 17:16:25 2009
@@ -6,6 +6,7 @@
README
Simple.pm
Simple.pod
+TODO
certs/server-cert.csr
certs/server-cert.pem
certs/server-key.pem
@@ -64,6 +65,7 @@
t/22_delete_multiple.t
t/35_imap_results_in_message_body.t
t/40_preauth.t
+t/45_search.t
t/Auth.pm
t/Connection.pm
t/Model.pm
Modified: branches/upstream/libnet-imap-simple-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-imap-simple-perl/current/META.yml?rev=47485&op=diff
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/META.yml (original)
+++ branches/upstream/libnet-imap-simple-perl/current/META.yml Thu Nov 19 17:16:25 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Net-IMAP-Simple
-version: 1.1907
+version: 1.1910
abstract: ~
author:
- Paul Miller <jettero at cpan.org>
Modified: branches/upstream/libnet-imap-simple-perl/current/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-imap-simple-perl/current/Simple.pm?rev=47485&op=diff
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/Simple.pm (original)
+++ branches/upstream/libnet-imap-simple-perl/current/Simple.pm Thu Nov 19 17:16:25 2009
@@ -8,7 +8,7 @@
use IO::Socket;
use IO::Select;
-our $VERSION = "1.1907";
+our $VERSION = "1.1910";
BEGIN {
# I'd really rather the pause/cpan indexers miss this "package"
@@ -333,10 +333,31 @@
my @lines;
- return $self->_process_cmd(
- cmd => [ FETCH => qq[$number RFC822.HEADER] ],
- final => sub { \@lines },
- process => sub { push @lines, $_[0] if $_[0] =~ /^(?: \s+\S+ | [^:]+: )/x },
+ ## 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[$number RFC822.HEADER] ],
+ final => sub { \@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];
+ }
+ },
);
}
@@ -374,6 +395,79 @@
},
);
}
+
+sub search {
+ my ($self, $search) = @_;
+ $search ||= "ALL";
+
+ my @seq;
+
+ return $self->_process_cmd(
+ cmd => [ SEARCH => $search ],
+ final => sub { wantarray ? @seq : int @seq },
+ process => sub { if ( my ($msgs) = $_[0] =~ /^\*\s+SEARCH\s+(.*)/i ) {
+ push @seq, $1 while $msgs =~ m/\b(\d+)\b/g;
+ } },
+ );
+}
+
+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-%m-%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 ) = @_;
@@ -780,10 +874,13 @@
$self->_seterrstr( $1 || 'unknown error' );
return 0;
+ } elsif ( $res =~ m/^\*\s+/ ) {
+
} else {
$self->_seterrstr("warning unknown return string (id=$id): $res");
- return;
- }
+ }
+
+ return;
}
sub _read_multiline {
Modified: branches/upstream/libnet-imap-simple-perl/current/Simple.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-imap-simple-perl/current/Simple.pod?rev=47485&op=diff
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/Simple.pod (original)
+++ branches/upstream/libnet-imap-simple-perl/current/Simple.pod Thu Nov 19 17:16:25 2009
@@ -175,7 +175,7 @@
print "Avaliable server flags: " . join(", ", $imap->flags) . "\n";
-This method accepts an optional folder name and returns the current avaliable
+This method accepts an optional folder name and returns the current available
server flags as a list, for the selected folder. If no folder name is provided
the last folder C<< $imap->select >>'ed will be used.
@@ -190,6 +190,8 @@
folder C<< $imap->select >>'ed will be used.
This method uses caching.
+
+See also: L<search>
=item unseen
@@ -205,8 +207,9 @@
B<NOTE>: This is not the opposite of L<seen> below. The UNSEEN value varies
from server to server, but according to the IMAP specification, it should be the
I<number of the first unseen message>, in the case the flag is provided. (If
-the flag is not provided, users would have to use the SEARCH command to find it
--- not implemented.)
+the flag is not provided, users would have to use the SEARCH command to find it.)
+
+See also: L<search>
=item current_box
@@ -342,7 +345,7 @@
This method logs out of the IMAP server, expunges the selected mailbox, and
closes the connection. No error message will ever be returned from this method.
-Optionally if BOOL is TRUE (1) then a hard quit is preformed which closes the
+Optionally if BOOL is TRUE (1) then a hard quit is performed which closes the
socket connection. This hard quit will still issue both EXPUNGE and LOGOUT
commands however the response is ignored and the socket is closed after issuing
the commands.
@@ -517,6 +520,175 @@
=back
+=head1 SEARCHING
+
+=over 4
+
+=item search
+
+This function returns an array of message numbers (in list context) or the
+number of matched messages (in scalar context). It takes a single argument: the
+search.
+
+IMAP searching can be a little confusing and this function makes no attempt to
+parse your searches. If you wish to do searches by hand, please see RFC 3501.
+
+Here are a few examples:
+
+ my @ids = $imap->search("UNSEEN");
+ my @ids = $imap->search('SUBJECT "blarg is \"blarg\""');
+ my @ids = $imap->search('FROM "joe at aol.com"');
+ my @ids = $imap->search("DELETED");
+
+ # example from RFC 3501, search terms are ANDed together
+ my @ids = $imap->search('FLAGGED SINCE 1-Feb-1994 NOT FROM "Smith"');
+
+ # flagged and ( since x or !from y ):
+ my @ids = $imap->search('FLAGGED OR SINCE x NOT FROM "y"');
+ # no typo above, see the RFC
+
+Since this module is meant to be simple, L<Net::IMAP::Simple> has a few search
+helpers. If you need fancy booleans and things, you'll have to learn search.
+If you need a quick search for unseen messages, see below.
+
+These all return an array of messages or count of messages exactly as the search
+function does. Some of them take arguments, some do not. They do try to grok
+your arguments slightly, the mechanics of this (if any) will be mentioned below.
+
+=over 4
+
+=item search_seen
+
+Returns numbers of messages that have the \Seen flag.
+
+=item search_recent
+
+Returns numbers of messages that have the \Recent flag.
+
+=item search_answered
+
+Returns numbers of messages that have the \Answered flag.
+
+=item search_deleted
+
+Returns numbers of messages that have the \Deleted flag.
+
+=item search_flagged
+
+Returns numbers of messages that have the \Flagged flag.
+
+=item search_draft
+
+Returns numbers of messages that have the \Draft flag.
+
+=item search_unseen
+
+Returns numbers of messages that do not have the \Seen flag.
+
+=item search_old
+
+Returns numbers of messages that do not have the \Recent flag.
+
+=item search_unanswered
+
+Returns numbers of messages that do not have the \Answered flag.
+
+=item search_undeleted
+
+Returns numbers of messages that do not have the \Deleted flag.
+
+=item search_unflagged
+
+Returns numbers of messages that do not have the \Flagged flag.
+
+=item search_smaller
+
+This function takes a single argument we'll call C<< <x> >> and returns numbers
+of messages that are smaller than C<< <x> >> octets. This function will try to
+force your argument to be a number before passing it to the IMAP server.
+
+=item search_larger
+
+This function takes a single argument we'll call C<< <x> >> and returns numbers
+of messages that are larger than C<< <x> >> octets. This function will try to
+force your argument to be a number before passing it to the IMAP server.
+
+=item search_from
+
+This function takes a single argument we'll call C<< <x> >> and returns numbers
+of messages that have C<< <x> >> in the from header. This function will attempt
+to force your string into the RFC3501 quoted-string format.
+
+=item search_to
+
+This function takes a single argument we'll call C<< <x> >> and returns numbers
+of messages that have C<< <x> >> in the to header. This function will attempt
+to force your string into the RFC3501 quoted-string format.
+
+=item search_cc
+
+This function takes a single argument we'll call C<< <x> >> and returns numbers
+of messages that have C<< <x> >> in the cc header. This function will attempt
+to force your string into the RFC3501 quoted-string format.
+
+=item search_bcc
+
+This function takes a single argument we'll call C<< <x> >> and returns numbers
+of messages that have C<< <x> >> in the bcc header. This function will attempt
+to force your string into the RFC3501 quoted-string format.
+
+=item search_subject
+
+This function takes a single argument we'll call C<< <x> >> and returns numbers
+of messages that have C<< <x> >> in the subject header. This function will attempt
+to force your string into the RFC3501 quoted-string format.
+
+=item search_body
+
+This function takes a single argument we'll call C<< <x> >> and returns numbers
+of messages that have C<< <x> >> in the message body. This function will
+attempt to force your string into the RFC3501 quoted-string format.
+
+=item search_before
+
+This function takes a single argument we'll call C<< <x> >> and returns numbers
+of messages that were received before C<< <x> >>. If you have L<Date::Manip>
+installed (optional), this function will attempt to force the date into the
+format C<%d-%m-%Y> (date-month-year) as RFC3501 requires. If you do not have
+that module, no attempt will be made to coerce your date into the correct
+format.
+
+=item search_since
+
+This function takes a single argument we'll call C<< <x> >> and returns numbers
+of messages that were received after C<< <x> >>. If you have L<Date::Manip>
+installed (optional), this function will attempt to force the date into the
+format C<%d-%m-%Y> (date-month-year) as RFC3501 requires. If you do not have
+that module, no attempt will be made to coerce your date into the correct
+format.
+
+=item search_sent_before
+
+This function takes a single argument we'll call C<< <x> >> and returns numbers
+of messages that have a header date before C<< <x> >>. If you have L<Date::Manip>
+installed (optional), this function will attempt to force the date into the
+format C<%d-%m-%Y> (date-month-year) as RFC3501 requires. If you do not have
+that module, no attempt will be made to coerce your date into the correct
+format.
+
+=item search_sent_since
+
+This function takes a single argument we'll call C<< <x> >> and returns numbers
+of messages that have a header date after C<< <x> >>. If you have L<Date::Manip>
+installed (optional), this function will attempt to force the date into the
+format C<%d-%m-%Y> (date-month-year) as RFC3501 requires. If you do not have
+that module, no attempt will be made to coerce your date into the correct
+format.
+
+=back
+
+=back
+
=head1 OTHER NOTES
=over 4
@@ -524,7 +696,7 @@
=item sequence set
Message numbers are never checked before being passed to the IMAP server (this
-is a "simple" module afteral), so in most places where a message number is
+is a "simple" module after all), so in most places where a message number is
required, you can instead use so-called I<sequence sets>. Examples:
$imap->copy( "3,4,9:22", "ANOTHERBOX" ) or die $imap->errstr;
Added: branches/upstream/libnet-imap-simple-perl/current/TODO
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-imap-simple-perl/current/TODO?rev=47485&op=file
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/TODO (added)
+++ branches/upstream/libnet-imap-simple-perl/current/TODO Thu Nov 19 17:16:25 2009
@@ -1,0 +1,4 @@
+- 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
Added: branches/upstream/libnet-imap-simple-perl/current/t/45_search.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-imap-simple-perl/current/t/45_search.t?rev=47485&op=file
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/t/45_search.t (added)
+++ branches/upstream/libnet-imap-simple-perl/current/t/45_search.t Thu Nov 19 17:16:25 2009
@@ -1,0 +1,37 @@
+use strict;
+use warnings;
+
+use Test;
+use Net::IMAP::Simple;
+
+plan tests => our $tests =
+ (my $puts = 5)*2
+ +2 # startup
+ +2 # subject searches
+ ;
+
+sub run_tests {
+ open INFC, ">>", "informal-imap-client-dump.log" or die $!;
+
+ my $imap = Net::IMAP::Simple->new('localhost:8000', debug=>\*INFC, use_ssl=>1)
+ or die "\nconnect failed: $Net::IMAP::Simple::errstr\n";
+
+ $imap->login(qw(working login));
+ my $nm = $imap->select('INBOX')
+ or die " failure selecting INBOX: " . $imap->errstr . "\n";
+
+ ok( 0+$imap->search_unseen, 0 );
+ ok( 0+$imap->search_recent, 0 );
+
+ for my $pnum (1 .. $puts) {
+ $imap->put( INBOX => "Subject: test-$pnum\n\ntest-$pnum" );
+
+ ok( 0+$imap->search_recent, $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_server.pm" or die "error starting imap server: $!$@";
More information about the Pkg-perl-cvs-commits
mailing list