| Subject: | Add getcapability() method |
I needed to be able to see the CAPABILITY information of an IMAP server for code that was already using Net::IMAP::Simple, and so I subclassed it (sort of) and added the method for myself. It's really trivial code and so I thought that I would share it in case you would like to add it to a future release. In fact, I did this so that I could access GETQUOTAROOT information. I guess I'll include that code also...
# Net::IMAP::Simple has no getcapability() method,
# so we added one.
sub getcapability($) {
my $self = shift @_;
my $imap = $self->{imap};
my @lines;
return $imap->_process_cmd(
cmd => [ "CAPABILITY" ],
final => sub {
my $cap_line = join( ' ', @lines);
my @caps = split(/\s+/, $cap_line);
if ($caps[0] eq '*') { shift @caps; }
return wantarray ? @caps : \@caps;
},
process => sub {
push @lines, @_;
},
);
}
# Net::IMAP::Simple has no getquotaroot() method,
# so we added one.
# https://tools.ietf.org/html/rfc2087#section-4.3
sub getquotaroot($$) {
my $self = shift @_;
my $mbname = shift @_ || 'INBOX';
if (! grep('QUOTA', $self->getcapability())) {
l0g(__PACKAGE__."::getquotaroot(): server does not support QUOTA extensions");
return undef;
}
my $imap = $self->{imap};
my @lines;
return $imap->_process_cmd(
cmd => [ "GETQUOTAROOT" => qq[$mbname] ],
final => sub {
for (my $i=0; $i <= $#lines; $i++) {
$lines[$i] =~ s/[\r\n]+$//;
$lines[$i] =~ s/^[*] //;
}
return wantarray ? @lines : \@lines
},
process => sub {
push @lines, @_;
},
);
}
I hope that this proves helpful.
--
Lester