r6345 - in /trunk/libnet-imap-simple-perl: Changes META.yml debian/changelog debian/control imap.pl lib/Net/IMAP/Simple.pm
rmayorga-guest at users.alioth.debian.org
rmayorga-guest at users.alioth.debian.org
Wed Aug 8 20:15:30 UTC 2007
Author: rmayorga-guest
Date: Wed Aug 8 20:15:30 2007
New Revision: 6345
URL: http://svn.debian.org/wsvn/?sc=1&rev=6345
Log:
* New Upstream release
Modified:
trunk/libnet-imap-simple-perl/Changes
trunk/libnet-imap-simple-perl/META.yml
trunk/libnet-imap-simple-perl/debian/changelog
trunk/libnet-imap-simple-perl/debian/control
trunk/libnet-imap-simple-perl/imap.pl
trunk/libnet-imap-simple-perl/lib/Net/IMAP/Simple.pm
Modified: trunk/libnet-imap-simple-perl/Changes
URL: http://svn.debian.org/wsvn/trunk/libnet-imap-simple-perl/Changes?rev=6345&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/Changes (original)
+++ trunk/libnet-imap-simple-perl/Changes Wed Aug 8 20:15:30 2007
@@ -1,4 +1,14 @@
Revision history for Perl extension Net::IMAP::Simple.
+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 at cs.wisc.edu. Patch provided by Nate.
Nate also provided new release tests - thanks man.
Modified: trunk/libnet-imap-simple-perl/META.yml
URL: http://svn.debian.org/wsvn/trunk/libnet-imap-simple-perl/META.yml?rev=6345&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/META.yml (original)
+++ trunk/libnet-imap-simple-perl/META.yml Wed Aug 8 20:15:30 2007
@@ -1,10 +1,10 @@
# 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.16
+version: 1.17
version_from: lib/Net/IMAP/Simple.pm
installdirs: site
requires:
distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+generated_by: ExtUtils::MakeMaker version 6.30
Modified: trunk/libnet-imap-simple-perl/debian/changelog
URL: http://svn.debian.org/wsvn/trunk/libnet-imap-simple-perl/debian/changelog?rev=6345&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/debian/changelog (original)
+++ trunk/libnet-imap-simple-perl/debian/changelog Wed Aug 8 20:15:30 2007
@@ -1,3 +1,10 @@
+libnet-imap-simple-perl (1.17-1) UNRELEASED; urgency=low
+
+ * New upstream release
+ * Added myself to uploaders
+
+ -- Rene Mayorga <rmayorga at debian.org.sv> Wed, 08 Aug 2007 14:14:29 -0600
+
libnet-imap-simple-perl (1.16-2) UNRELEASED; urgency=low
* Fix typo in Description
Modified: trunk/libnet-imap-simple-perl/debian/control
URL: http://svn.debian.org/wsvn/trunk/libnet-imap-simple-perl/debian/control?rev=6345&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/debian/control (original)
+++ trunk/libnet-imap-simple-perl/debian/control Wed Aug 8 20:15:30 2007
@@ -4,7 +4,7 @@
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> , gregor herrmann <gregor+debian at comodo.priv.at>
+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>, Rene Mayorga <rmayorga at debian.org.sv>
Standards-Version: 3.7.2
XS-Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libnet-imap-simple-perl/
XS-Vcs-Browser: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/
Modified: trunk/libnet-imap-simple-perl/imap.pl
URL: http://svn.debian.org/wsvn/trunk/libnet-imap-simple-perl/imap.pl?rev=6345&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/imap.pl (original)
+++ trunk/libnet-imap-simple-perl/imap.pl Wed Aug 8 20:15:30 2007
@@ -1,3 +1,4 @@
+#!/usr/bin/perl
require 'lib/Net/IMAP/Simple.pm';
print "Square brackets: [] indicate optional arguments\n\n";
print "IMAP Server[:port] [localhost]: ";
@@ -41,15 +42,87 @@
}
system("stty echo");
+print "\n";
-print "Mail boxes:\n";
-for($imap->mailboxes){
- s/\./ -> /g;
- print "BOX: $_\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 <box>
+ select box <box> - Select a mail box
+ select folder <folder> - Select a folder within <box>, 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}" : '') . "] ";
}
-
-print "Recent: " . $imap->recent . "\n";
-print " Flags: " . $imap->flags . "\n";
-print "Flag List: " . join(" ", $imap->flags) . "\n";
-
-$imap->quit;
Modified: trunk/libnet-imap-simple-perl/lib/Net/IMAP/Simple.pm
URL: http://svn.debian.org/wsvn/trunk/libnet-imap-simple-perl/lib/Net/IMAP/Simple.pm?rev=6345&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/lib/Net/IMAP/Simple.pm (original)
+++ trunk/libnet-imap-simple-perl/lib/Net/IMAP/Simple.pm Wed Aug 8 20:15:30 2007
@@ -4,7 +4,7 @@
use IO::Socket;
use vars qw[$VERSION];
-$VERSION = $1 if('$Id: Simple.pm,v 1.16 2006/06/13 15:47:00 cfaber Exp $' =~ /,v ([\d.]+) /);
+$VERSION = $1 if('$Id: Simple.pm,v 1.17 2006/10/11 16:23:45 cfaber Exp $' =~ /,v ([\d_.]+) /);
=head1 NAME
@@ -62,35 +62,47 @@
On success an object is returned. On failure, nothing is returned and an error message is set to $Net::IMAP::Simple.
-B<OPTIONS:>
-
-
- port => Assign the port number (default: 143)
-
- timeout => Connection timeout in seconds.
-
- retry => Attempt to retry the connection
- -> attmpt (x) times before giving up
-
-
- retry_delay => Wait (x) seconds before retrying a
- -> connection attempt
-
-
- use_v6 => If set to true, attempt to use IPv6
- -> sockets rather than IPv4 sockets.
- -> This option requires the
- -> IO::Socket::INET6 module
-
-
- bindaddr => Assign a local address to bind
-
-
- use_select_cache => Enable select() caching internally
-
- select_cache_ttl => The number of seconds to allow a
- -> select cache result live before running
- ->select() again.
+=head2 OPTIONS:
+
+Options are provided as a hash to new()
+
+=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 IO::Socket::INET6 module
+
+=item bindaddr => str
+
+Assign a local address to bind
+
+=item use_select_cache => BOOL
+
+Enable select() caching internally
+
+=item select_cache_ttl => int
+
+The number of seconds to allow a select cache result live before running $imap->select() again.
+
+=item debug => BOOL | \*HANDLE
+
+Enable debugging output. If \*HANDLE is a valid file handle, debugging will be written to it. Otherwise debugging will be written to STDOUT
=cut
@@ -113,6 +125,8 @@
$self->{bindaddr} = $opts{bindaddr};
$self->{use_select_cache} = $opts{use_select_cache};
$self->{select_cache_ttl} = $opts{select_cache_ttl};
+ $self->{debug} = $opts{debug};
+
# 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){
@@ -238,7 +252,7 @@
}
}
},
- );
+ ) || return;
return $self->{last}
}
@@ -516,12 +530,16 @@
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//;
_escape($res);
push @list, $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;
@@ -540,7 +558,7 @@
This method returns a list of mailboxes. 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.
+section 6.3.8 has more information.
On failure nothing is returned and the errstr() error handler is set with the error message.
@@ -557,7 +575,7 @@
return $self->_process_cmd(
cmd => [LIST => qq[$ref *]],
final => sub { _unescape($_) for @list; @list },
- process => sub { push @list, $self->_process_list($_[0]) },
+ process => sub { push @list, $self->_process_list($_[0]);},
);
} else {
return $self->_process_cmd(
@@ -800,6 +818,9 @@
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);
}
@@ -807,6 +828,8 @@
sub _cmd_ok {
my ($self, $res) = @_;
my $id = $self->_count;
+
+ $self->_debug(caller, __LINE__, '_send_cmd', $res) if $self->{debug};
if($res =~ /^$id\s+OK/i){
return 1;
@@ -814,7 +837,7 @@
$self->_seterrstr($1 || 'unknown error');
return 0;
} else {
- $self->_seterrstr("unknown return string: $res");
+ $self->_seterrstr("warning unknown return string: $res");
return;
}
}
@@ -828,6 +851,12 @@
push @lines, $sock->getline;
$read_so_far += length($lines[-1]);
}
+ if($self->{debug}){
+ for(my $i = 0; $i < @lines; $i++){
+ $self->_debug(caller, __LINE__, '_read_multiline', "[$i] $lines[$i]");
+ }
+ }
+
return @lines;
}
@@ -837,6 +866,8 @@
my $res;
while ( $res = $sock->getline ) {
+ $self->_debug(caller, __LINE__, '_process_cmd', $res) if $self->{debug};
+
if ( $res =~ /^\*.*\{(\d+)\}$/ ) {
$args{process}->($res);
$args{process}->($_) foreach $self->_read_multiline($sock, $1);
@@ -856,9 +887,24 @@
sub _seterrstr {
my ($self, $err) = @_;
$self->{_errstr} = $err;
+ $self->_debug(caller, __LINE__, '_seterrstr', $err) if $self->{debug};
return;
}
+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 $line = "[$package :: $filename :: $line\@$dline -> $routine] $str\n";
+ if(ref($self->{debug}) eq 'GLOB'){
+ write($self->{debug}, $line);
+ } else {
+ print STDOUT $line;
+ }
+}
=pod
More information about the Pkg-perl-cvs-commits
mailing list