[Bps-public-commit] r9315 - in Net-Server-IMAP: lib/Net/Server/IMAP lib/Net/Server/IMAP/Command
alexmv at bestpractical.com
alexmv at bestpractical.com
Mon Oct 15 19:54:05 EDT 2007
Author: alexmv
Date: Mon Oct 15 19:54:05 2007
New Revision: 9315
Modified:
Net-Server-IMAP/ (props changed)
Net-Server-IMAP/lib/Net/Server/IMAP/Command.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Uid.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Mailbox.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Message.pm
Log:
r23611 at zoq-fot-pik: chmrr | 2007-10-15 19:51:20 -0400
* get_uids moves to mailbox, not some random command
* Fix parsing of COMPLEX[HEADER (requests like this)]
* Use hashes to describe type for data_out
* Force email addresses to be strings (one sample was 23423 at foo.com,
which broke pine)
* Expunge should delete from the uid cache
* Throw in a couple 'use bytes' in a half-hearted attempt to care
about encodings
* Return empty string when there are no valid headers asked for
* Empty MIME sections should be NIL, not \undef, which doesn't show
at all in data_out
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command.pm Mon Oct 15 19:54:05 2007
@@ -61,7 +61,7 @@
return $self->_parsed_options if not defined $str and not defined $self->options_str;
my @parsed;
- for my $term (grep {/\S/} split /($RE{delimited}{-delim=>'"'}|$RE{balanced}{-parens=>'()'}|\S+)/, $str || $self->options_str) {
+ for my $term (grep {/\S/} split /($RE{delimited}{-delim=>'"'}|$RE{balanced}{-parens=>'()'}|\S+$RE{balanced}{-parens=>'()[]<>'}|\S+)/, $str || $self->options_str) {
if ($term =~ /^$RE{delimited}{-delim=>'"'}{-keep}$/) {
push @parsed, $3;
} elsif ($term =~ /^$RE{balanced}{-parens=>'()'}$/) {
@@ -91,6 +91,16 @@
return "(" . join( " ", map { $self->data_out($_) } @{$data} ) . ")";
} elsif ( ref $data eq "SCALAR" ) {
return $$data;
+ } elsif ( ref $data eq "HASH") {
+ if ($data->{type} eq "string") {
+ if ( $data =~ /[{"\r\n%*\\\[]/ ) {
+ return "{" . ( length($data->{value}) ) . "}\r\n$data";
+ } else {
+ return '"' . $data->{value} .'"';
+ }
+ } elsif ($data->{type} eq "literal") {
+ return "{" . ( length($data->{value}) ) . "}\r\n$data";
+ }
} elsif ( not ref $data ) {
if ( not defined $data ) {
return "NIL";
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Uid.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Uid.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Uid.pm Mon Oct 15 19:54:05 2007
@@ -29,31 +29,13 @@
}
-sub get_uids {
- my $self = shift;
- my $str = shift;
-
- my @ids;
- for ( split ',', $str ) {
- if (/^(\d+):(\d+)$/) {
- push @ids, $1 .. $2;
- } elsif (/^(\d+):\*$/) {
- push @ids, $1 .. $self->connection->selected->uidnext;
- } elsif (/^(\d+)$/) {
- push @ids, $1;
- }
- }
- return
- grep {defined} map { $self->connection->selected->uids->{$_} } @ids;
-}
-
sub fetch {
my $self = shift;
my ( $messages, $spec ) = @_;
$spec = [$spec] unless ref $spec;
push @{$spec}, "UID" unless grep {uc $_ eq "UID"} @{$spec};
- my @messages = $self->get_uids($messages);
+ my @messages = $self->connection->selected->get_uids($messages);
for my $m (@messages) {
$self->untagged_response( $m->sequence
. " FETCH "
@@ -70,7 +52,7 @@
my ( $messages, $what, @flags ) = @_;
@flags = map {ref $_ ? @{$_} : $_} @flags;
- my @messages = $self->get_uids($messages);
+ my @messages = $self->connection->selected->get_uids($messages);
for my $m (@messages) {
$m->store( $what => @flags );
$self->untagged_response( $m->sequence
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Mailbox.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Mailbox.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Mailbox.pm Mon Oct 15 19:54:05 2007
@@ -64,6 +64,24 @@
return grep {defined} map { $self->messages->[ $_ - 1 ] } @ids;
}
+sub get_uids {
+ my $self = shift;
+ my $str = shift;
+
+ my @ids;
+ for ( split ',', $str ) {
+ if (/^(\d+):(\d+)$/) {
+ push @ids, $1 .. $2;
+ } elsif (/^(\d+):\*$/) {
+ push @ids, $1 .. $self->uidnext;
+ } elsif (/^(\d+)$/) {
+ push @ids, $1;
+ }
+ }
+ return
+ grep {defined} map { $self->uids->{$_} } @ids;
+}
+
sub add_child {
my $self = shift;
my $node = ( ref $self )
@@ -133,6 +151,7 @@
for my $m (@messages) {
if ( $m->has_flag('\Deleted') ) {
push @ids, $m->sequence - $offset;
+ delete $self->uids->{$m->uid};
$offset++;
$m->expunge;
} elsif ($offset) {
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Message.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Message.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Message.pm Mon Oct 15 19:54:05 2007
@@ -103,6 +103,7 @@
push @out, [ map { \$_ } $self->flags ];
} elsif ( uc $part eq "RFC822.SIZE" ) {
my $result = $self->mime_select( [], undef, undef );
+ use bytes;
push @out, length $result;
} elsif ( uc $part eq "BODY" ) {
push @out, $self->mime_bodystructure( $self->mime, 0 );
@@ -135,7 +136,7 @@
for my $h ( @{$extras} ) {
$header->header_set( $case{$h} || $h => $mime->header($h) );
}
- $result = $header->as_string . "\n";
+ $result = $header->as_string ? $header->as_string . "\n" : "";
} elsif ( uc $_ eq "TEXT" ) {
$result = $mime->body;
} elsif ( $_ =~ /^\d+$/i ) {
@@ -183,7 +184,7 @@
} @parts;
return [
- \$parts,
+ $parts ? \$parts : undef,
$data->{composite},
( $long
? ( ( %{ $data->{attributes} }
@@ -220,7 +221,7 @@
scalar $mime->header("Content-ID"),
scalar $mime->header("Content-Description"),
( scalar $mime->header("Content-Transfer-Encoding") or "7BIT" ),
- length $body,
+ do {use bytes; length $body},
( defined $lines
? ( $lines, )
: ()
@@ -248,7 +249,11 @@
my $mime = $self->mime;
return undef unless $mime->header($header);
- return [ map { [ $_->name, undef, $_->user, $_->host ] }
+ return [ map { [ {type => "string", value => $_->name},
+ undef,
+ {type => "string", value => $_->user},
+ {type => "string", value => $_->host}
+ ] }
Email::Address->parse( $mime->header($header) ) ];
}
More information about the Bps-public-commit
mailing list