[Bps-public-commit] Net-IMAP-Server branch, master, updated. 1.24-1-g089e84a
Alex M Vandiver
alexmv at bestpractical.com
Fri Oct 16 16:55:43 EDT 2009
The branch, master has been updated
via 089e84a6958e1ed829e6ac7c847ddb80cfdd7644 (commit)
from 239a2c44e89456da5f8b98b2cde2b07b7e2787fb (commit)
Summary of changes:
lib/Net/IMAP/Server/Command/Create.pm | 3 ++-
lib/Net/IMAP/Server/Command/List.pm | 21 ++++++++++++++-------
lib/Net/IMAP/Server/Command/Rename.pm | 3 ++-
lib/Net/IMAP/Server/DefaultModel.pm | 11 +++++++++--
lib/Net/IMAP/Server/Mailbox.pm | 3 +++
5 files changed, 30 insertions(+), 11 deletions(-)
- Log -----------------------------------------------------------------
commit 089e84a6958e1ed829e6ac7c847ddb80cfdd7644
Author: Dan Keder <keder at fi.muni.cz>
Date: Fri Oct 16 16:53:47 2009 -0400
Support mailboxes with flat hierarchies (undef hiararchy separator)
diff --git a/lib/Net/IMAP/Server/Command/Create.pm b/lib/Net/IMAP/Server/Command/Create.pm
index 294104e..67a2c97 100644
--- a/lib/Net/IMAP/Server/Command/Create.pm
+++ b/lib/Net/IMAP/Server/Command/Create.pm
@@ -37,7 +37,8 @@ sub run {
my $base = $self->connection->model->root;
for my $n (0.. $#parts) {
- my $path = join($self->connection->model->root->separator, @parts[0 .. $n]);
+ my $sep = $self->connection->model->root->separator || "";
+ my $path = join($sep, @parts[0 .. $n]);
my $part = $self->connection->model->lookup($path);
unless ($part) {
unless ($part = $base->create( name => $parts[$n] )) {
diff --git a/lib/Net/IMAP/Server/Command/List.pm b/lib/Net/IMAP/Server/Command/List.pm
index aaef217..e0ede35 100644
--- a/lib/Net/IMAP/Server/Command/List.pm
+++ b/lib/Net/IMAP/Server/Command/List.pm
@@ -27,14 +27,18 @@ sub run {
# 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->root->separator
- . q{" ""} );
+ my $sep = (defined $self->connection->model->root->separator)
+ ? q{"}.$self->connection->model->root->separator.q{"} : "NIL";
+ $self->tagged_response( qq|(\\Noselect) $sep ""| );
} else {
my $sep = $self->connection->model->root->separator;
$search = quotemeta($search);
$search =~ s/\\\*/.*/g;
- $search =~ s/\\%/[^$sep]+/g;
+ if (defined $sep) {
+ $search =~ s/\\%/[^$sep]*/g;
+ } else {
+ $search =~ s/\\%/.*/g;
+ }
my $regex = qr{^\Q$root\E$search$};
$self->connection->model->root->update_tree;
$self->traverse( $self->connection->model->root, $regex );
@@ -48,9 +52,11 @@ sub list_out {
my $node = shift;
my @props = @_;
- my $str = $self->data_out([map {\$_} @props]);
- $str .= q{ "} . $self->connection->model->root->separator . q{" };
- $str .= q{"} . Encode::encode('IMAP-UTF-7',$node->full_path) . q{"};
+ my $sep = (defined $self->connection->model->root->separator)
+ ? q{"}.$self->connection->model->root->separator.q{"} : "NIL";
+ my $name = q{"}.Encode::encode('IMAP-UTF-7',$node->full_path).q{"};
+
+ my $str = $self->data_out([map {\$_} @props]) . " $sep $name";
$self->tagged_response($str);
}
@@ -61,6 +67,7 @@ sub traverse {
my @props;
push @props, @{$node->children} ? '\HasChildren' : '\HasNoChildren';
+ push @props, '\Noinferiors' unless defined $self->connection->model->root->separator;
push @props, '\Noselect' unless $node->is_selectable;
$self->list_out($node, @props) if $node->parent and
diff --git a/lib/Net/IMAP/Server/Command/Rename.pm b/lib/Net/IMAP/Server/Command/Rename.pm
index 1c7a3cd..fa9f2ee 100644
--- a/lib/Net/IMAP/Server/Command/Rename.pm
+++ b/lib/Net/IMAP/Server/Command/Rename.pm
@@ -34,7 +34,8 @@ sub run {
my $base = $self->connection->model->root;
for my $n (0.. $#parts) {
- my $path = join($self->connection->model->root->separator, @parts[0 .. $n]);
+ my $sep = $self->connection->model->root->separator || "";
+ my $path = join($sep, @parts[0 .. $n]);
my $part = $self->connection->model->lookup($path);
unless ($part) {
unless ($part = $base->create( name => $parts[$n] )) {
diff --git a/lib/Net/IMAP/Server/DefaultModel.pm b/lib/Net/IMAP/Server/DefaultModel.pm
index 02cbb9e..454b8ab 100644
--- a/lib/Net/IMAP/Server/DefaultModel.pm
+++ b/lib/Net/IMAP/Server/DefaultModel.pm
@@ -101,16 +101,23 @@ Utility method which splits a given C<PATH> according to the mailbox
separator, as determined by the
L<Net::IMAP::Server::Mailbox/separator> of the L</root>. May C<die>
if the path (which is expected to be encoded using IMAP-UTF-7) is
-invalid. See L<Encode::IMAPUTF7>.
+invalid. See L<Encode::IMAPUTF7>. If the mailbox hierarchy is flat
+(i.e. the separator is undef), returns the name without change.
=cut
sub split {
my $self = shift;
my $name = shift;
+
$name = eval { Encode::decode('IMAP-UTF-7', $name) };
die "BAD Invalid UTF-7 encoding\n" unless defined $name;
- return grep {length} split quotemeta $self->root->separator, $name;
+
+ if (defined $self->root->separator) {
+ return grep {length} split quotemeta $self->root->separator, $name;
+ } else {
+ return $name;
+ }
}
=head2 lookup PATH
diff --git a/lib/Net/IMAP/Server/Mailbox.pm b/lib/Net/IMAP/Server/Mailbox.pm
index c36a08c..d7ccc47 100644
--- a/lib/Net/IMAP/Server/Mailbox.pm
+++ b/lib/Net/IMAP/Server/Mailbox.pm
@@ -343,6 +343,9 @@ sub close { }
Returns the path separator. Note that only the path separator of the
root mailbox matters. Defaults to a forward slash.
+If the function returns is undef, the server supports only flat
+mailboxes (i.e. no child mailboxes are allowed).
+
=cut
sub separator {
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list