[Bps-public-commit] Net-IMAP-Server branch, master, updated. 1.24-1-g089e84a

[Alex M Vandiver]

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 {

-----------------------------------------------------------------------