[Bps-public-commit] r9367 - in Net-Server-IMAP: lib/Net/Server/IMAP/Command

[alexmv at bestpractical.com]

Author: alexmv
Date: Fri Oct 19 17:36:39 2007
New Revision: 9367

Modified:
   Net-Server-IMAP/   (props changed)
   Net-Server-IMAP/lib/Net/Server/IMAP/Command/List.pm
   Net-Server-IMAP/lib/Net/Server/IMAP/Command/Lsub.pm
   Net-Server-IMAP/lib/Net/Server/IMAP/Command/Subscribe.pm
   Net-Server-IMAP/lib/Net/Server/IMAP/Command/Unsubscribe.pm

Log:
 r23758 at zoq-fot-pik:  chmrr | 2007-10-19 17:35:32 -0400
  * Fix SUBSCRIBE and UNSUBSCRIBE
  * LSUB does the right thing with % queries


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 17:36:39 2007
@@ -39,19 +39,27 @@
     $self->ok_completed;
 }
 
+sub list_out {
+    my $self = shift;
+    my $node = shift;
+    my @props = @_;
+
+    my $str = $self->data_out([map {\$_} @props]);
+    $str .= q{ "} . $self->connection->model->root->seperator . q{" };
+    $str .= q{"} . $node->full_path . q{"};
+    $self->tagged_response($str);
+}
+
 sub traverse {
     my $self  = shift;
     my $node  = shift;
     my $regex = shift;
 
     my @props;
-    push @props, @{$node->children} ? \'\HasChildren' : \'\HasNoChildren';
+    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{" };
-    $str .= q{"} . $node->full_path . q{"};
-    $self->tagged_response($str) if $node->parent and $node->full_path =~ $regex;
+    $self->list_out($node, @props) if $node->parent and $node->full_path =~ $regex;
     $self->traverse( $_, $regex ) for @{ $node->children };
 }
 

Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Lsub.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Lsub.pm	(original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Lsub.pm	Fri Oct 19 17:36:39 2007
@@ -6,11 +6,22 @@
 use base qw/Net::Server::IMAP::Command::List/;
 
 sub traverse {
-    my $self = shift;
-    my $node = shift;
+    my $self  = shift;
+    my $node  = shift;
+    my $regex = shift;
 
-    return unless $node->subscribed;
-    $self->SUPER::traverse( $node, @_ );
+    $self->list_out($node) if $node->parent and $node->full_path =~ $regex and $node->subscribed;
+    my @kids = grep {$_} map {$self->traverse( $_, $regex )} @{ $node->children };
+    if (@kids and $node->parent and not $node->subscribed) {
+        if ($node->full_path =~ $regex) {
+            $self->list_out($node, '\NoSelect');
+            return 0;
+        } else {
+            return 1;
+        }
+    }
+    return 1 if $node->parent and not $node->full_path =~ $regex and $node->subscribed;
+    return 0;
 }
 
 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 17:36:39 2007
@@ -23,8 +23,8 @@
 sub run {
     my $self = shift;
 
-    my $mailbox = $self->connection->model->lookup( @options );
-    $mailbox->subscribe(1);
+    my $mailbox = $self->connection->model->lookup( $self->parsed_options );
+    $mailbox->subscribed(1);
 
     $self->ok_completed();
 }

Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Unsubscribe.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Unsubscribe.pm	(original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Unsubscribe.pm	Fri Oct 19 17:36:39 2007
@@ -23,8 +23,8 @@
 sub run {
     my $self = shift;
 
-    my $mailbox = $self->connection->model->lookup( @options );
-    $mailbox->subscribe(0);
+    my $mailbox = $self->connection->model->lookup( $self->parsed_options );
+    $mailbox->subscribed(0);
 
     $self->ok_completed();
 }