package Net::IMAP::Server::Command::Lsub; use warnings; use strict; use base qw/Net::IMAP::Server::Command::List/; sub traverse { my $self = shift; my $node = shift; my $regex = shift; $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;