r3078 - in /packages/libnet-imap-simple-perl/trunk: Changes META.yml
debian/changelog debian/compat debian/control lib/Net/IMAP/Simple.pm
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Sat Jun 17 15:13:32 UTC 2006
Author: gregoa-guest
Date: Sat Jun 17 15:13:31 2006
New Revision: 3078
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=3078
Log:
* New upstream release.
* Set Debhelper Compatibility Level to 5.
* Set Standards-Version to 3.7.2 (no changes).
Modified:
packages/libnet-imap-simple-perl/trunk/Changes
packages/libnet-imap-simple-perl/trunk/META.yml
packages/libnet-imap-simple-perl/trunk/debian/changelog
packages/libnet-imap-simple-perl/trunk/debian/compat
packages/libnet-imap-simple-perl/trunk/debian/control
packages/libnet-imap-simple-perl/trunk/lib/Net/IMAP/Simple.pm
Modified: packages/libnet-imap-simple-perl/trunk/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-imap-simple-perl/trunk/Changes?rev=3078&op=diff
==============================================================================
--- packages/libnet-imap-simple-perl/trunk/Changes (original)
+++ packages/libnet-imap-simple-perl/trunk/Changes Sat Jun 17 15:13:31 2006
@@ -1,4 +1,16 @@
Revision history for Perl extension Net::IMAP::Simple.
+1.16 2006-06-13
+ - Multiple bugs identified by nate at 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
Modified: packages/libnet-imap-simple-perl/trunk/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-imap-simple-perl/trunk/META.yml?rev=3078&op=diff
==============================================================================
--- packages/libnet-imap-simple-perl/trunk/META.yml (original)
+++ packages/libnet-imap-simple-perl/trunk/META.yml Sat Jun 17 15:13:31 2006
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Net-IMAP-Simple
-version: 1.14
+version: 1.16
version_from: lib/Net/IMAP/Simple.pm
installdirs: site
requires:
Modified: packages/libnet-imap-simple-perl/trunk/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-imap-simple-perl/trunk/debian/changelog?rev=3078&op=diff
==============================================================================
--- packages/libnet-imap-simple-perl/trunk/debian/changelog (original)
+++ packages/libnet-imap-simple-perl/trunk/debian/changelog Sat Jun 17 15:13:31 2006
@@ -1,3 +1,11 @@
+libnet-imap-simple-perl (1.16-1) unstable; urgency=low
+
+ * New upstream release.
+ * Set Debhelper Compatibility Level to 5.
+ * Set Standards-Version to 3.7.2 (no changes).
+
+ -- gregor herrmann <gregor+debian at comodo.priv.at> Sat, 17 Jun 2006 17:10:55 +0200
+
libnet-imap-simple-perl (1.14-1) unstable; urgency=low
* New upstream release
Modified: packages/libnet-imap-simple-perl/trunk/debian/compat
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-imap-simple-perl/trunk/debian/compat?rev=3078&op=diff
==============================================================================
--- packages/libnet-imap-simple-perl/trunk/debian/compat (original)
+++ packages/libnet-imap-simple-perl/trunk/debian/compat Sat Jun 17 15:13:31 2006
@@ -1,1 +1,1 @@
-4
+5
Modified: packages/libnet-imap-simple-perl/trunk/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-imap-simple-perl/trunk/debian/control?rev=3078&op=diff
==============================================================================
--- packages/libnet-imap-simple-perl/trunk/debian/control (original)
+++ packages/libnet-imap-simple-perl/trunk/debian/control Sat Jun 17 15:13:31 2006
@@ -1,11 +1,11 @@
Source: libnet-imap-simple-perl
Section: perl
Priority: optional
-Build-Depends: debhelper (>= 4.0.2)
+Build-Depends: debhelper (>= 5.0.0)
Build-Depends-Indep: perl (>= 5.8.0-7)
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: Allard Hoeve <allard at byte.nl>, Gunnar Wolf <gwolf at debian.org>, Joachim Breitner <nomeata at debian.org>
-Standards-Version: 3.6.2
+Uploaders: Allard Hoeve <allard at byte.nl>, Gunnar Wolf <gwolf at debian.org>, Joachim Breitner <nomeata at debian.org> , gregor herrmann <gregor+debian at comodo.priv.at>
+Standards-Version: 3.7.2
Package: libnet-imap-simple-perl
Architecture: all
Modified: packages/libnet-imap-simple-perl/trunk/lib/Net/IMAP/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libnet-imap-simple-perl/trunk/lib/Net/IMAP/Simple.pm?rev=3078&op=diff
==============================================================================
--- packages/libnet-imap-simple-perl/trunk/lib/Net/IMAP/Simple.pm (original)
+++ packages/libnet-imap-simple-perl/trunk/lib/Net/IMAP/Simple.pm Sat Jun 17 15:13:31 2006
@@ -4,7 +4,7 @@
use IO::Socket;
use vars qw[$VERSION];
-$VERSION = $1 if('$Id: Simple.pm,v 1.14 2005/10/01 22:46:50 cfaber Exp $' =~ /,v ([\d.]+) /);
+$VERSION = $1 if('$Id: Simple.pm,v 1.16 2006/06/13 15:47:00 cfaber Exp $' =~ /,v ([\d.]+) /);
=head1 NAME
@@ -111,13 +111,20 @@
$self->{retry} = ($opts{retry} ? $opts{retry} : $self->_retry);
$self->{retry_delay} = ($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};
+
+ # Pop the port off the address string if it's not an IPv6 IP address
+ if(!$self->{use_v6} && $self->{server} =~ /^[A-Fa-f0-9]{4}:[A-Fa-f0-9]{4}:/ && $self->{server} =~ s/:(\d+)$//g){
+ $self->{port} = $1;
+ }
+
my $c;
- for(my $i = 0; $i < $self->{retry}; $i++){
+ for(my $i = 0; $i <= $self->{retry}; $i++){
if($self->{sock} = $self->_connect){
$c = 1;
last;
- } else {
+ } elsif ($i < $self->{retry}) {
select(undef, undef, undef, $self->{retry_delay});
}
}
@@ -510,14 +517,14 @@
sub _process_list {
my ($self, $line) = @_;
my @list;
- if ( $line =~ /^\*\s+LIST.*\s+\{\d+\}\s*$/i ) {
+ if ( $line =~ /^\*\s+(LIST|LSUB).*\s+\{\d+\}\s*$/i ) {
chomp( my $res = $self->_sock->getline );
$res =~ s/\r//;
_escape($res);
push @list, $res;
- } elsif ( $line =~ /^\*\s+LIST.*\s+(\".*?\")\s*$/i ||
- $line =~ /^\*\s+LIST.*\s+(\S+)\s*$/i ) {
- push @list, $1;
+ } elsif ( $line =~ /^\*\s+(LIST|LSUB).*\s+(\".*?\")\s*$/i ||
+ $line =~ /^\*\s+(LIST|LSUB).*\s+(\S+)\s*$/i ) {
+ push @list, $2;
}
@list;
}
@@ -563,6 +570,45 @@
=pod
+=item mailboxes_subscribed
+
+ my @boxes = $imap->mailboxes_subscribed;
+ my @folders = $imap->mailboxes_subscribed("Mail/%");
+ my @lists = $imap->mailboxes_subscribed("lists/perl/*", "/Mail/");
+
+This method returns a list of mailboxes subscribed to. When called with no
+arguments it recurses from the IMAP root to get all mailboxes. The first optional
+argument is a mailbox path and the second is the path reference. RFC 3501
+has more information.
+
+On failure nothing is returned and the errstr() error handler is set with the error message.
+
+=cut
+
+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 { _unescape($_) for @list; @list },
+ process => sub { push @list, $self->_process_list($_[0]) },
+ );
+ } else {
+ return $self->_process_cmd(
+ cmd => [LSUB => qq[$ref $box]],
+ final => sub { _unescape($_) for @list; @list },
+ process => sub { push @list, $self->_process_list($_[0]) },
+ );
+ }
+}
+
+=pod
+
=item create_mailbox
print "Created" if $imap->create_mailbox( "/Mail/lists/perl/advocacy" );
@@ -596,7 +642,7 @@
sub expunge_mailbox {
my ($self, $box) = @_;
- $self->select($box);
+ return if !$self->select($box);
return $self->_process_cmd(
cmd => ['EXPUNGE'],
@@ -664,8 +710,9 @@
sub folder_subscribe {
my ($self, $box) = @_;
- $self->select($box);
-
+ $self->select($box); # XXX does it matter if this fails?
+ _escape($box);
+
return $self->_process_cmd(
cmd => [SUBSCRIBE => $box],
final => sub { 1 },
@@ -687,7 +734,8 @@
sub folder_unsubscribe {
my ($self, $box) = @_;
$self->select($box);
-
+ _escape($box);
+
return $self->_process_cmd(
cmd => [UNSUBSCRIBE => $box],
final => sub { 1 },
@@ -769,8 +817,18 @@
$self->_seterrstr("unknown return string: $res");
return;
}
-
- return;
+}
+
+sub _read_multiline {
+ my ($self, $sock, $count) = @_;
+
+ my @lines;
+ my $read_so_far = 0;
+ while ($read_so_far < $count) {
+ push @lines, $sock->getline;
+ $read_so_far += length($lines[-1]);
+ }
+ return @lines;
}
sub _process_cmd {
@@ -779,13 +837,18 @@
my $res;
while ( $res = $sock->getline ) {
- my $ok = $self->_cmd_ok($res);
- if ( defined($ok) && $ok == 1 ) {
- return $args{final}->($res);
- } elsif ( defined($ok) && ! $ok ) {
- return;
+ if ( $res =~ /^\*.*\{(\d+)\}$/ ) {
+ $args{process}->($res);
+ $args{process}->($_) foreach $self->_read_multiline($sock, $1);
} 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);
+ }
}
}
}
More information about the Pkg-perl-cvs-commits
mailing list