r6344 - in /branches/upstream/libnet-imap-simple-perl: 1.17/ 1.17/Changes 1.17/META.yml 1.17/imap.pl 1.17/lib/Net/IMAP/Simple.pm current/Changes current/META.yml current/imap.pl current/lib/Net/IMAP/Simple.pm

rmayorga-guest at users.alioth.debian.org rmayorga-guest at users.alioth.debian.org
Wed Aug 8 20:13:57 UTC 2007


Author: rmayorga-guest
Date: Wed Aug  8 20:13:57 2007
New Revision: 6344

URL: http://svn.debian.org/wsvn/?sc=1&rev=6344
Log:
* New Upstream release

Added:
    branches/upstream/libnet-imap-simple-perl/1.17/
      - copied from r6343, branches/upstream/libnet-imap-simple-perl/current/
Modified:
    branches/upstream/libnet-imap-simple-perl/1.17/Changes
    branches/upstream/libnet-imap-simple-perl/1.17/META.yml
    branches/upstream/libnet-imap-simple-perl/1.17/imap.pl
    branches/upstream/libnet-imap-simple-perl/1.17/lib/Net/IMAP/Simple.pm
    branches/upstream/libnet-imap-simple-perl/current/Changes
    branches/upstream/libnet-imap-simple-perl/current/META.yml
    branches/upstream/libnet-imap-simple-perl/current/imap.pl
    branches/upstream/libnet-imap-simple-perl/current/lib/Net/IMAP/Simple.pm

Modified: branches/upstream/libnet-imap-simple-perl/1.17/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-imap-simple-perl/1.17/Changes?rev=6344&op=diff
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/1.17/Changes (original)
+++ branches/upstream/libnet-imap-simple-perl/1.17/Changes Wed Aug  8 20:13:57 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: branches/upstream/libnet-imap-simple-perl/1.17/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-imap-simple-perl/1.17/META.yml?rev=6344&op=diff
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/1.17/META.yml (original)
+++ branches/upstream/libnet-imap-simple-perl/1.17/META.yml Wed Aug  8 20:13:57 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: branches/upstream/libnet-imap-simple-perl/1.17/imap.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-imap-simple-perl/1.17/imap.pl?rev=6344&op=diff
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/1.17/imap.pl (original)
+++ branches/upstream/libnet-imap-simple-perl/1.17/imap.pl Wed Aug  8 20:13:57 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: branches/upstream/libnet-imap-simple-perl/1.17/lib/Net/IMAP/Simple.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-imap-simple-perl/1.17/lib/Net/IMAP/Simple.pm?rev=6344&op=diff
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/1.17/lib/Net/IMAP/Simple.pm (original)
+++ branches/upstream/libnet-imap-simple-perl/1.17/lib/Net/IMAP/Simple.pm Wed Aug  8 20:13:57 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
 

Modified: branches/upstream/libnet-imap-simple-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-imap-simple-perl/current/Changes?rev=6344&op=diff
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/Changes (original)
+++ branches/upstream/libnet-imap-simple-perl/current/Changes Wed Aug  8 20:13:57 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: branches/upstream/libnet-imap-simple-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-imap-simple-perl/current/META.yml?rev=6344&op=diff
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/META.yml (original)
+++ branches/upstream/libnet-imap-simple-perl/current/META.yml Wed Aug  8 20:13:57 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: branches/upstream/libnet-imap-simple-perl/current/imap.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-imap-simple-perl/current/imap.pl?rev=6344&op=diff
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/imap.pl (original)
+++ branches/upstream/libnet-imap-simple-perl/current/imap.pl Wed Aug  8 20:13:57 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: branches/upstream/libnet-imap-simple-perl/current/lib/Net/IMAP/Simple.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-imap-simple-perl/current/lib/Net/IMAP/Simple.pm?rev=6344&op=diff
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/lib/Net/IMAP/Simple.pm (original)
+++ branches/upstream/libnet-imap-simple-perl/current/lib/Net/IMAP/Simple.pm Wed Aug  8 20:13:57 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