imap: support LIST command

We'll optimize for the common case of: $TAG LIST "" *
and rely on the grep perlfunc to handle trickier cases.

2 files changed, 39 insertions, 0 deletions

diff --git a/lib/PublicInbox/IMAP.pm b/lib/PublicInbox/IMAP.pm
index 7745d9f9..ca9a0ea7 100644
--- a/lib/PublicInbox/IMAP.pm
+++ b/lib/PublicInbox/IMAP.pm
@@ -336,6 +336,20 @@ sub cmd_status ($$$;@) {
         "$tag OK Status complete\r\n";
 }
 
+my %patmap = ('*' => '.*', '%' => '[^\.]*');
+sub cmd_list ($$$$) {
+        my ($self, $tag, $refname, $wildcard) = @_;
+        my $l = $self->{imapd}->{inboxlist};
+        if ($refname eq '' && $wildcard eq '') {
+                # request for hierarchy delimiter
+                $l = [ qq[* LIST (\\Noselect) "." ""\r\n] ];
+        } elsif ($refname ne '' || $wildcard ne '*') {
+                $wildcard =~ s!([^a-z0-9_])!$patmap{$1} // "\Q$1"!eig;
+                $l = [ grep(/ \Q$refname\E$wildcard\r\n\z/s, @$l) ];
+        }
+        \(join('', @$l, "$tag OK List complete\r\n"));
+}
+
 sub cmd_uid_fetch ($$$;@) {
         my ($self, $tag, $range, @want) = @_;
         my $ibx = $self->{ibx} or return "$tag BAD No mailbox selected\r\n";
diff --git a/lib/PublicInbox/IMAPD.pm b/lib/PublicInbox/IMAPD.pm
index 05aa30e4..a3a25986 100644
--- a/lib/PublicInbox/IMAPD.pm
+++ b/lib/PublicInbox/IMAPD.pm
@@ -21,10 +21,35 @@ sub new {
         }, $class;
 }
 
+sub refresh_inboxlist ($) {
+        my ($self) = @_;
+        my @names = map { $_->{newsgroup} } @{delete $self->{grouplist}};
+        my %ns; # "\Noselect \HasChildren"
+        for (@names) {
+                my $up = $_;
+                while ($up =~ s/\.[^\.]+\z//) {
+                        $ns{$up} = '\\Noselect \\HasChildren';
+                }
+        }
+        @names = map {;
+                my $at = delete($ns{$_}) ? '\\HasChildren' : '\\HasNoChildren';
+                qq[* LIST ($at) "." $_\r\n]
+        } @names;
+        push(@names, map { qq[* LIST ($ns{$_}) "." $_\r\n] } keys %ns);
+        @names = sort {
+                my ($xa) = ($a =~ / (\S+)\r\n/g);
+                my ($xb) = ($b =~ / (\S+)\r\n/g);
+                length($xa) <=> length($xb);
+        } @names;
+        $self->{inboxlist} = \@names;
+}
+
 sub refresh_groups {
         my ($self) = @_;
         my $pi_config = $self->{pi_config} = PublicInbox::Config->new;
         $self->SUPER::refresh_groups($pi_config);
+        refresh_inboxlist($self);
+
         if (my $idler = $self->{idler}) {
                 $idler->refresh($pi_config);
         }