[Bps-public-commit] r9363 - in Net-Server-IMAP: lib/Net/Server/IMAP lib/Net/Server/IMAP/Command
alexmv at bestpractical.com
alexmv at bestpractical.com
Fri Oct 19 15:34:02 EDT 2007
Author: alexmv
Date: Fri Oct 19 15:33:57 2007
New Revision: 9363
Added:
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Unsubscribe.pm
Modified:
Net-Server-IMAP/ (props changed)
Net-Server-IMAP/lib/Net/Server/IMAP/Command.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Append.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/List.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Select.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Starttls.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Status.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Subscribe.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Mailbox.pm
Log:
r23751 at zoq-fot-pik: chmrr | 2007-10-19 15:32:57 -0400
* Mailboxes have a ->selectable flag
* SUBSCRIBE and UNSUBSCRIBE do things
* APPEND deals with internaldate and flags arguments
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 Fri Oct 19 15:33:57 2007
@@ -27,14 +27,14 @@
sub has_literal {
my $self = shift;
- unless ($self->options_str =~ /\{(\d+)\}$/) {
+ unless ($self->options_str =~ /\{(\d+)\}[\r\n]*$/) {
$self->parse_options;
return;
}
my $options = $self->options_str;
my $next = $#{$self->_literals} + 1;
- $options =~ s/\{(\d+)\}$/{{$next}}/;
+ $options =~ s/\{(\d+)\}[\r\n]*$/{{$next}}/;
$self->_pending_literal($1);
$self->options_str($options);
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Append.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Append.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Append.pm Fri Oct 19 15:33:57 2007
@@ -5,6 +5,8 @@
use base qw/Net::Server::IMAP::Command/;
+use DateTime::Format::Strptime;
+
sub validate {
my $self = shift;
@@ -27,10 +29,21 @@
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;
+ if (my $msg = $mailbox->append(pop @options)) {
+ if (@options and grep {ref $_} @options) {
+ my ($flags) = grep {ref $_} @options;
+ $msg->set_flag($_, 1) for @{$flags};
+ }
+ if (@options and grep {not ref $_} @options) {
+ my ($time) = grep {not ref $_} @options;
+ my $parser = DateTime::Format::Strptime->new(pattern => "%e-%b-%Y %T %z");
+ my $dt = $parser->parse_datetime($time);
+ return $self->bad_command("Invalid date") unless $dt;
+ $msg->internaldate( $parser->format_datetime($dt) );
+ }
+
+ $self->connection->previous_exists( ($self->connection->previous_exists + 1 )
+ if $self->connection->is_selected and $mailbox eq $self->connection->selected;
$self->ok_completed();
} else {
$self->no_command("Permission denied");
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 Fri Oct 19 15:33:57 2007
@@ -46,6 +46,7 @@
my @props;
push @props, @{$node->children} ? \'\HasChildren' : \'\HasNoChildren';
+ push @props, '\Noselect' unless $node->selectable;
my $str = $self->data_out(\@props);
$str .= q{ "} . $self->connection->model->root->seperator . q{" };
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 Fri Oct 19 15:33:57 2007
@@ -16,6 +16,7 @@
my $mailbox = $self->connection->model->lookup( @options );
return $self->no_command("Mailbox does not exist") unless $mailbox;
+ return $self->no_command("Mailbox is not selectable") unless $mailbox->selectable;
return 1;
}
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Starttls.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Starttls.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Starttls.pm Fri Oct 19 15:33:57 2007
@@ -10,9 +10,15 @@
sub validate {
my $self = shift;
+ return $self->bad_command("Already logged in")
+ unless $self->connection->is_unauth;
+
my @options = $self->parsed_options;
return $self->bad_command("Too many options") if @options;
+ return $self->no_command("STARTTLS is disabled")
+ unless $self->connection->capability =~ /\bSTARTTLS\b/;
+
return 1;
}
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 Fri Oct 19 15:33:57 2007
@@ -19,6 +19,7 @@
my $mailbox = $self->connection->model->lookup( $name );
return $self->no_command("Mailbox does not exist") unless $mailbox;
+ return $self->no_command("Mailbox is not selectable") unless $mailbox->selectable;
return 1;
}
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Subscribe.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Subscribe.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Subscribe.pm Fri Oct 19 15:33:57 2007
@@ -8,6 +8,8 @@
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 < 1;
return $self->bad_command("Too many options") if @options > 1;
@@ -21,6 +23,9 @@
sub run {
my $self = shift;
+ my $mailbox = $self->connection->model->lookup( @options );
+ $mailbox->subscribe(1);
+
$self->ok_completed();
}
Added: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Unsubscribe.pm
==============================================================================
--- (empty file)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Unsubscribe.pm Fri Oct 19 15:33:57 2007
@@ -0,0 +1,32 @@
+package Net::Server::IMAP::Command::Unsubscribe;
+
+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 < 1;
+ return $self->bad_command("Too many options") if @options > 1;
+
+ my $mailbox = $self->connection->model->lookup( @options );
+ return $self->no_command("Mailbox does not exist") unless $mailbox;
+
+ return 1;
+}
+
+sub run {
+ my $self = shift;
+
+ my $mailbox = $self->connection->model->lookup( @options );
+ $mailbox->subscribe(0);
+
+ $self->ok_completed();
+}
+
+1;
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 Fri Oct 19 15:33:57 2007
@@ -7,7 +7,7 @@
use base 'Class::Accessor';
__PACKAGE__->mk_accessors(
- qw(name is_inbox force_read_only parent children _path uidnext uids messages)
+ qw(name is_inbox force_read_only parent children _path uidnext uids uidvalidity messages subscribed)
);
sub new {
@@ -24,6 +24,8 @@
$self->messages( [] );
$self->uids( {} );
$self->children( [] );
+ $self->uidvalidity( scalar time );
+ $self->subscribed( 1 );
my $name = $self->full_path;
return unless $name;
@@ -43,6 +45,10 @@
return "/";
}
+sub selectable {
+ return 1;
+}
+
sub selected {
my $self = shift;
return $Net::Server::IMAP::Server->connection->selected
@@ -160,19 +166,9 @@
return $self->flags;
}
-sub uidvalidity {
- my $self = shift;
- return $^T;
-}
-
sub read_only {
my $self = shift;
- return $self->force_read_only or 0;
-}
-
-sub subscribed {
- my $self = shift;
- return 1;
+ return $self->force_read_only;
}
sub expunge {
@@ -215,7 +211,7 @@
my $m = Net::Server::IMAP::Message->new(@_);
$m->set_flag('\Recent', 1);
$self->add_message($m);
- return 1;
+ return $m;
}
sub poll {}
More information about the Bps-public-commit
mailing list