[Bps-public-commit] r9343 - in Net-Server-IMAP: . lib/Net/Server/IMAP lib/Net/Server/IMAP/Command
alexmv at bestpractical.com
alexmv at bestpractical.com
Wed Oct 17 17:54:28 EDT 2007
Author: alexmv
Date: Wed Oct 17 17:54:27 2007
New Revision: 9343
Added:
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Append.pm
Modified:
Net-Server-IMAP/ (props changed)
Net-Server-IMAP/lib/Net/Server/IMAP.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Check.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Expunge.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Fetch.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/List.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Noop.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Search.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Select.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Status.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Store.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Uid.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Connection.pm
Net-Server-IMAP/lib/Net/Server/IMAP/DefaultModel.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Mailbox.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Message.pm
Log:
r23711 at zoq-fot-pik: chmrr | 2007-10-17 17:54:15 -0400
* FETCH, EXPUNGE, and EXISTS are now automatically updated from
Mailbox or Message changes
* Mailboxes had a model, which is wrong (they have possibly
multiple); the link was removed, and the only reason for the link (the
seperator) was moved to the mailbox
* Because the messages in a mailbox depends which connection is
asking, ->get_messages and ->sequence moved to the connection, from
the mailbox. Connections also acquired more state, about what the
client had been told.
* Preliminary APPEND support
* Fix literal parsing -- it only worked for one-line literals,
previously
* Messages know their mailbox
Modified: Net-Server-IMAP/lib/Net/Server/IMAP.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP.pm Wed Oct 17 17:54:27 2007
@@ -72,6 +72,8 @@
} else {
# Process socket
+ local $Net::Server::IMAP::Server = $self;
+ local $self->{connection} = $self->connections->{ $fh->fileno };
$self->connections->{ $fh->fileno }->handle_command;
}
}
@@ -85,13 +87,28 @@
$self->socket->close if $self->socket;
}
+sub connection {
+ my $self = shift;
+ return $self->{connection};
+}
+
+sub concurrent_connections {
+ my $class = shift;
+ my $self = ref $class ? $class : $Net::Server::IMAP::Server;
+ my $selected = shift || $self->connection->selected;
+
+ return () unless $selected;
+ return grep {$_->is_auth and $_->is_selected
+ and $_->selected eq $selected} values %{$self->connections};
+}
+
sub accept_connection {
my $self = shift;
my $handle = shift;
$self->select->add($handle);
my $conn = Net::Server::IMAP::Connection->new(
io_handle => $handle,
- server => $self
+ server => $self,
);
$self->connections->{ $handle->fileno } = $conn;
return $conn;
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 Wed Oct 17 17:54:27 2007
@@ -5,7 +5,7 @@
use base 'Class::Accessor';
use Regexp::Common qw/delimited/;
-__PACKAGE__->mk_accessors(qw(server connection command_id options_str command _parsed_options _literals));
+__PACKAGE__->mk_accessors(qw(server connection command_id options_str command _parsed_options _literals _pending_literal));
sub new {
my $class = shift;
@@ -35,20 +35,23 @@
my $options = $self->options_str;
my $next = $#{$self->_literals} + 1;
$options =~ s/\{(\d+)\}$/{{$next}}/;
- my $length = $1;
+ $self->_pending_literal($1);
$self->options_str($options);
# Pending
$self->connection->pending(sub {
+ use bytes;
my $content = shift;
- {
- use bytes;
- $self->_literals->[$next] = substr($content, 0, $length, "");
+ if (length $content < $self->_pending_literal) {
+ $self->_literals->[$next] .= $content;
+ $self->_pending_literal( $self->_pending_literal - length $content);
+ } else {
+ $self->_literals->[$next] = substr($content, 0, $self->_pending_literal, "");
+ $self->connection->pending(undef);
+ $self->options_str($self->options_str . $content);
+ return if $self->has_literal;
+ $self->run if $self->validate;
}
- $self->connection->pending(undef);
- $self->options_str($self->options_str . $content);
- return if $self->has_literal;
- $self->run if $self->validate;
});
$self->out( "+ Continue\r\n" );
return 1;
@@ -117,10 +120,7 @@
sub untagged_response {
my $self = shift;
- while ( my $message = shift ) {
- next unless $message;
- $self->out( "* " . $message . "\r\n" );
- }
+ $self->connection->untagged_response(@_);
}
sub tagged_response {
@@ -131,6 +131,12 @@
}
}
+sub send_untagged {
+ my $self = shift;
+
+ $self->connection->send_untagged( @_ );
+}
+
sub ok_command {
my $self = shift;
my $message = shift;
@@ -139,6 +145,7 @@
$self->untagged_response(
"OK [" . uc($_) . "] " . $extra_responses{$_} );
}
+ $self->send_untagged;
$self->out( $self->command_id . " " . "OK " . $message . "\r\n" );
return 1;
}
@@ -151,6 +158,7 @@
$self->untagged_response(
"NO [" . uc($_) . "] " . $extra_responses{$_} );
}
+ $self->send_untagged;
$self->out( $self->command_id . " " . "NO " . $message . "\r\n" );
return 0;
}
@@ -176,6 +184,7 @@
sub bad_command {
my $self = shift;
my $reason = shift;
+ $self->send_untagged;
$self->out( $self->command_id . " " . "BAD " . $reason . "\r\n" );
return 0;
}
Added: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Append.pm
==============================================================================
--- (empty file)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Append.pm Wed Oct 17 17:54:27 2007
@@ -0,0 +1,39 @@
+package Net::Server::IMAP::Command::Append;
+
+use warnings;
+use strict;
+
+use base qw/Net::Server::IMAP::Command/;
+
+sub validate {
+ my $self = shift;
+
+ return $self->bad_command("Log in first") if $self->connection->is_unauth;
+
+ my @options = $self->parsed_options;
+ return $self->bad_command("Not enough options") if @options < 2;
+ return $self->bad_command("Too many options") if @options > 4;
+
+ my $mailbox = $self->connection->model->lookup( $options[0] );
+ return $self->no_command("Mailbox does not exist") unless $mailbox;
+
+ return 1;
+}
+
+sub run {
+ my $self = shift;
+
+ my @options = $self->parsed_options;
+
+ my $mailbox = $self->connection->model->lookup( shift @options );
+ # XXX TODO: Deal with flags, internaldate
+ if ($mailbox->append(pop @options)) {
+ $self->connection->previous_exists( $self->connection->previous_exists + 1 )
+ if $mailbox eq $self->connection->selected;
+ $self->ok_completed();
+ } else {
+ $self->no_command("Permission denied");
+ }
+}
+
+1;
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Check.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Check.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Check.pm Wed Oct 17 17:54:27 2007
@@ -21,8 +21,6 @@
sub run {
my $self = shift;
- $self->connection->selected->poll if $self->connection->is_auth and $self->connection->is_selected;
-
$self->ok_completed();
}
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Expunge.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Expunge.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Expunge.pm Wed Oct 17 17:54:27 2007
@@ -23,8 +23,7 @@
sub run {
my $self = shift;
- my @ids = $self->connection->selected->expunge;
- $self->untagged_response( map {"$_ EXPUNGE"} @ids );
+ $self->connection->selected->expunge;
$self->ok_completed();
}
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Fetch.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Fetch.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Fetch.pm Wed Oct 17 17:54:27 2007
@@ -23,14 +23,20 @@
my $self = shift;
my ( $messages, $spec ) = $self->parsed_options;
- my @messages = $self->connection->selected->get_messages($messages);
- for (@messages) {
- $self->untagged_response( $_->sequence
+ my @messages = $self->connection->get_messages($messages);
+ for my $m (@messages) {
+ $self->untagged_response( $self->connection->sequence($m)
. " FETCH "
- . $self->data_out( [ $_->fetch($spec) ] ) );
+ . $self->data_out( [ $m->fetch($spec) ] ) );
}
$self->ok_completed();
}
+sub send_untagged {
+ my $self = shift;
+
+ $self->SUPER::send_untagged( expunged => 0 );
+}
+
1;
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/List.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/List.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/List.pm Wed Oct 17 17:54:27 2007
@@ -25,10 +25,10 @@
# In the special case of a query for the delimiter, give them our delimiter
if ( $search eq "" ) {
$self->tagged_response( q{(\Noselect) "}
- . $self->connection->model->seperator
+ . $self->connection->model->root->seperator
. q{" ""} );
} else {
- my $sep = $self->connection->model->seperator;
+ my $sep = $self->connection->model->root->seperator;
$search = quotemeta($search);
$search =~ s/\\\*/.*/g;
$search =~ s/\\%/[^$sep]/g;
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Noop.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Noop.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Noop.pm Wed Oct 17 17:54:27 2007
@@ -17,8 +17,6 @@
sub run {
my $self = shift;
- $self->connection->selected->poll if $self->connection->is_auth and $self->connection->is_selected;
-
$self->ok_completed();
}
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Search.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Search.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Search.pm Wed Oct 17 17:54:27 2007
@@ -21,7 +21,7 @@
my $filter = $self->filter($self->parsed_options);
return unless $filter;
- my @results = map {$_->sequence} grep {$filter->($_)} @{$self->connection->selected->messages};
+ my @results = map {$self->connection->sequence($_)} grep {$filter->($_)} $self->connection->get_messages('1:*');
$self->untagged_response("SEARCH @results");
$self->ok_completed;
}
@@ -133,7 +133,7 @@
push @{$filters}, sub {not $_[0]->has_flag('\Seen')};
} elsif ($token =~ /^\d+(:\d+|:\*)?(,\d+(:\d+|:\*))*$/) {
my %uids;
- $uids{$_->uid}++ for $self->connection->selected->get_messages($token);
+ $uids{$_->uid}++ for $self->connection->get_messages($token);
push @{$filters}, sub {$uids{$_[0]->uid}};
} elsif (ref $token) {
unshift @stack, [AND => -1 => $filters, \@tokens];
@@ -162,4 +162,10 @@
return shift @{$filters};
}
+sub send_untagged {
+ my $self = shift;
+
+ $self->SUPER::send_untagged( expunged => 0 );
+}
+
1;
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Select.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Select.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Select.pm Wed Oct 17 17:54:27 2007
@@ -26,6 +26,7 @@
my $mailbox = $self->connection->model->lookup( $self->parsed_options );
$mailbox->force_read_only(1) if $self->command eq "Examine";
+ $mailbox->poll;
$self->connection->selected($mailbox);
$self->untagged_response(
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Status.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Status.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Status.pm Wed Oct 17 17:54:27 2007
@@ -28,6 +28,7 @@
my ( $name, $flags ) = @options;
my $mailbox = $self->connection->model->lookup( $self->connection, $name );
+ $mailbox->poll;
my %items;
$items{ uc $_ } = undef for @{$flags};
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Store.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Store.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Store.pm Wed Oct 17 17:54:27 2007
@@ -26,16 +26,20 @@
my ( $messages, $what, @flags ) = $self->parsed_options;
@flags = map {ref $_ ? @{$_} : $_} @flags;
- my @messages = $self->connection->selected->get_messages($messages);
+ my @messages = $self->connection->get_messages($messages);
+ $self->connection->ignore_flags(1) if $what =~ /\.SILENT$/i;
for my $m (@messages) {
$m->store( $what => @flags );
- $self->untagged_response( $m->sequence
- . " FETCH "
- . $self->data_out( [ $m->fetch("FLAGS") ] ) )
- unless $what =~ /\.SILENT$/i;
}
+ $self->connection->ignore_flags(0) if $what =~ /\.SILENT$/i;
$self->ok_completed();
}
+sub send_untagged {
+ my $self = shift;
+
+ $self->SUPER::send_untagged( expunged => 0 );
+}
+
1;
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 Wed Oct 17 17:54:27 2007
@@ -37,7 +37,7 @@
push @{$spec}, "UID" unless grep {uc $_ eq "UID"} @{$spec};
my @messages = $self->connection->selected->get_uids($messages);
for my $m (@messages) {
- $self->untagged_response( $m->sequence
+ $self->untagged_response( $self->connection->sequence($m)
. " FETCH "
. $self->data_out( [ $m->fetch($spec) ] ) );
}
@@ -53,13 +53,13 @@
my ( $messages, $what, @flags ) = @_;
@flags = map {ref $_ ? @{$_} : $_} @flags;
my @messages = $self->connection->selected->get_uids($messages);
+ $self->connection->ignore_flags(1) if $what =~ /\.SILENT$/i;
for my $m (@messages) {
$m->store( $what => @flags );
- $self->untagged_response( $m->sequence
- . " FETCH "
- . $self->data_out( [ $m->fetch([qw/UID FLAGS/]) ] ) )
- unless $what =~ /\.SILENT$/i;
+ $self->connection->untagged_fetch->{$self->connection->sequence($m)}{UID}++
+ unless $what =~ /\.SILENT$/i;
}
+ $self->connection->ignore_flags(0) if $what =~ /\.SILENT$/i;
$self->ok_completed;
}
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Connection.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Connection.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Connection.pm Wed Oct 17 17:54:27 2007
@@ -7,11 +7,11 @@
use Net::Server::IMAP::Command;
-__PACKAGE__->mk_accessors(qw(server io_handle selected model pending));
+__PACKAGE__->mk_accessors(qw(server io_handle selected model pending temporary_messages temporary_sequence_map previous_exists untagged_expunge untagged_fetch ignore_flags));
sub new {
my $class = shift;
- my $self = $class->SUPER::new( { @_, state => "unauth" } );
+ my $self = $class->SUPER::new( { @_, state => "unauth", untagged_expunge => [], untagged_fetch => {} } );
$self->greeting;
return $self;
}
@@ -117,6 +117,77 @@
return $self->{auth};
}
+sub untagged_response {
+ my $self = shift;
+ while ( my $message = shift ) {
+ next unless $message;
+ $self->out( "* " . $message . "\r\n" );
+ }
+}
+
+sub send_untagged {
+ my $self = shift;
+ my %args = ( expunged => 1,
+ @_ );
+ return unless $self->is_auth and $self->is_selected;
+
+ {
+ # When we poll, the things that we find should affect this
+ # connection as well; hence, the local to be "connection-less"
+ local $Net::Server::IMAP::Server->{connection};
+ $self->selected->poll;
+ }
+
+ for my $s (keys %{$self->untagged_fetch}) {
+ my($m) = $self->get_messages($s);
+ $self->untagged_response( $s
+ . " FETCH "
+ . Net::Server::IMAP::Command->data_out( [ $m->fetch([keys %{$self->untagged_fetch->{$s}}]) ] ) );
+ }
+ $self->untagged_fetch({});
+
+ if ($args{expunged}) {
+ $self->previous_exists( $self->previous_exists - @{$self->untagged_expunge} );
+ $self->untagged_response( map {"$_ EXPUNGE"} @{$self->untagged_expunge} );
+ $self->untagged_expunge([]);
+ $self->temporary_messages(undef);
+ }
+
+ my $expected = $self->previous_exists;
+ my $now = @{$self->temporary_messages || $self->selected->messages};
+ $self->untagged_response( $now . ' EXISTS' ) if $expected != $now;
+ $self->previous_exists($now);
+
+}
+
+sub get_messages {
+ my $self = shift;
+ my $str = shift;
+
+ my $messages = $self->temporary_messages || $self->selected->messages;
+
+ my @ids;
+ for ( split ',', $str ) {
+ if (/^(\d+):(\d+)$/) {
+ push @ids, $1 .. $2;
+ } elsif (/^(\d+):\*$/) {
+ push @ids, $1 .. @{ $messages } + 0;
+ } elsif (/^(\d+)$/) {
+ push @ids, $1;
+ }
+ }
+ return grep {defined} map { $messages->[ $_ - 1 ] } @ids;
+}
+
+sub sequence {
+ my $self = shift;
+ my $message = shift;
+
+ return $message->sequence unless $self->temporary_messages;
+ return $self->temporary_sequence_map->{$message};
+}
+
+
sub log {
my $self = shift;
my $msg = shift;
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/DefaultModel.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/DefaultModel.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/DefaultModel.pm Wed Oct 17 17:54:27 2007
@@ -30,15 +30,11 @@
return $self;
}
-sub seperator {
- return "/";
-}
-
sub lookup {
my $self = shift;
my $name = shift;
$name = "INBOX" if uc $name eq "INBOX";
- my @parts = split $self->seperator, $name;
+ my @parts = split $self->root->seperator, $name;
return undef unless @parts and shift @parts eq $self->root->name;
my $part = $self->root;
while (@parts) {
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 Wed Oct 17 17:54:27 2007
@@ -7,7 +7,7 @@
use base 'Class::Accessor';
__PACKAGE__->mk_accessors(
- qw(name model force_read_only parent children _path uidnext uids messages)
+ qw(name force_read_only parent children _path uidnext uids messages)
);
sub new {
@@ -37,6 +37,16 @@
}
}
+sub seperator {
+ return "/";
+}
+
+sub selected {
+ my $self = shift;
+ return $Net::Server::IMAP::Server->connection->selected
+ and $Net::Server::IMAP::Server->connection->selected eq $self;
+}
+
sub add_message {
my $self = shift;
my $message = shift;
@@ -44,24 +54,17 @@
$self->uidnext( $self->uidnext + 1 );
$message->sequence( @{ $self->messages } + 1 );
push @{ $self->messages }, $message;
+ $message->mailbox($self);
$self->uids->{ $message->uid } = $message;
-}
-sub get_messages {
- my $self = shift;
- my $str = shift;
+ # Also need to add it to anyone that has this folder as a
+ # temporary message store
+ for my $c (Net::Server::IMAP->concurrent_connections($self)) {
+ next unless $c->temporary_messages;
- my @ids;
- for ( split ',', $str ) {
- if (/^(\d+):(\d+)$/) {
- push @ids, $1 .. $2;
- } elsif (/^(\d+):\*$/) {
- push @ids, $1 .. @{ $self->messages } + 0;
- } elsif (/^(\d+)$/) {
- push @ids, $1;
- }
+ push @{$c->temporary_messages}, $message;
+ $c->temporary_sequence_map->{$message} = scalar @{$c->temporary_messages};
}
- return grep {defined} map { $self->messages->[ $_ - 1 ] } @ids;
}
sub get_uids {
@@ -85,7 +88,7 @@
sub add_child {
my $self = shift;
my $node = ( ref $self )
- ->new( { @_, parent => $self, model => $self->model } );
+ ->new( { @_, parent => $self } );
$self->children( [] ) unless $self->children;
push @{ $self->children }, $node;
return $node;
@@ -97,7 +100,7 @@
return $self->name unless $self->parent;
$self->_path(
- $self->parent->full_path . $self->model->seperator . $self->name );
+ $self->parent->full_path . $self->seperator . $self->name );
return $self->_path;
}
@@ -108,6 +111,8 @@
sub exists {
my $self = shift;
+ $Net::Server::IMAP::Server->connection->previous_exists( scalar @{ $self->messages } )
+ if $self->selected;
return scalar @{ $self->messages };
}
@@ -148,6 +153,17 @@
my $offset = 0;
my @messages = @{ $self->messages };
$self->messages( [ grep { not $_->has_flag('\Deleted') } @messages ] );
+ for my $c (Net::Server::IMAP->concurrent_connections($self)) {
+ # Ensure that all other connections with this selected get a
+ # temporary message list, if they don't already have one
+ unless (($Net::Server::IMAP::Server->connection and $c eq $Net::Server::IMAP::Server->connection)
+ or $c->temporary_messages) {
+ $c->temporary_messages([@messages]);
+ $c->temporary_sequence_map({});
+ $c->temporary_sequence_map->{$_} = $_->sequence for @messages;
+ }
+ }
+
for my $m (@messages) {
if ( $m->has_flag('\Deleted') ) {
push @ids, $m->sequence - $offset;
@@ -158,12 +174,23 @@
$m->sequence( $m->sequence - $offset );
}
}
- return @ids;
+
+ for my $c (Net::Server::IMAP->concurrent_connections($self)) {
+ # Also, each connection gets these added to their expunge list
+ push @{$c->untagged_expunge}, @ids;
+ }
}
-sub poll {
+sub append {
+ my $self = shift;
+ my $m = Net::Server::IMAP::Message->new(@_);
+ $m->set_flag('\Recent', 1);
+ $self->add_message($m);
+ return 1;
}
+sub poll {}
+
package Email::IMAPFolder;
use base 'Email::Folder';
use YAML;
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 Wed Oct 17 17:54:27 2007
@@ -12,7 +12,7 @@
use base 'Class::Accessor';
-__PACKAGE__->mk_accessors(qw(sequence uid _flags mime internaldate));
+__PACKAGE__->mk_accessors(qw(sequence mailbox uid _flags mime internaldate));
sub new {
my $class = shift;
@@ -31,6 +31,13 @@
my $flag = shift;
my $old = exists $self->_flags->{$flag};
$self->_flags->{$flag} = 1;
+
+ unless ($old or @_) {
+ for my $c (Net::Server::IMAP->concurrent_connections($self->mailbox)) {
+ $c->untagged_fetch->{$c->sequence($self)}{FLAGS}++ unless $c->ignore_flags;
+ }
+ }
+
return not $old;
}
@@ -39,6 +46,13 @@
my $flag = shift;
my $old = exists $self->_flags->{$flag};
delete $self->_flags->{$flag};
+
+ if ($old or @_) {
+ for my $c (Net::Server::IMAP->concurrent_connections($self->mailbox)) {
+ $c->untagged_fetch->{$c->sequence($self)}{FLAGS}++ unless $c->ignore_flags;
+ }
+ }
+
return $old;
}
@@ -74,7 +88,7 @@
my @out;
for my $part (@parts) {
- push @out, \$part;
+ push @out, \(uc $part);
# Now that we've split out the right tag, do some aliasing
if ( uc $part eq "RFC822" ) {
@@ -174,11 +188,10 @@
# hate thee. Make the mime structures, hack them into the
# IMAP format, concat them, and insert their reference so they
# get spat out as-is.
- my $fake_command = Net::Server::IMAP::Command->new;
my @parts = $mime->parts;
@parts = () if @parts == 1 and $parts[0] == $mime;
my $parts = join '', map {
- $fake_command->data_out( $self->mime_bodystructure( $_, $long ) )
+ Net::Server::IMAP::Command->data_out( $self->mime_bodystructure( $_, $long ) )
} @parts;
return [
More information about the Bps-public-commit
mailing list