The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Net::IMAP::Server::Command::Uid;

use warnings;
use strict;

use base qw/Net::IMAP::Server::Command/;
use Net::IMAP::Server::Command::Search;

use Coro;

sub validate {
    my $self = shift;

    return $self->bad_command("Login first") if $self->connection->is_unauth;
    return $self->bad_command("Select a mailbox first")
        unless $self->connection->is_selected;

    my @options = $self->parsed_options;
    return $self->bad_command("Not enough options") if @options < 1;

    return 1;
}

sub run {
    my $self = shift;

    my ($subcommand, @rest) = $self->parsed_options;
    $subcommand = lc $subcommand;
    if ($subcommand =~ /^(copy|fetch|store|search|expunge)$/i ) {
        $self->$subcommand(@rest);
    } else {
        $self->log(
            $subcommand . " wasn't understood by the 'UID' command" );
        $self->bad_command(
            q{Unrecognized UID command $subcommand} );
    }

}

sub fetch {
    my $self = shift;

    return $self->bad_command("Not enough options") if @_ < 2;
    return $self->bad_command("Too many options") if @_ > 2;

    my ( $messages, $spec ) = @_;
    $spec = [$spec] unless ref $spec;
    unshift @{$spec}, "UID" unless grep {uc $_ eq "UID"} @{$spec};
    my @messages = $self->connection->selected->get_uids($messages);
    for my $m (@messages) {
        $self->untagged_response( $self->connection->sequence($m)
                . " FETCH "
                . $self->data_out( [ $m->fetch($spec) ] ) );
        cede;
    }

    $self->ok_completed();
}

sub store {
    my $self = shift;

    return $self->bad_command("Mailbox is read-only") if $self->connection->selected->read_only;

    return $self->bad_command("Not enough options") if @_ < 3;
    return $self->bad_command("Too many options") if @_ > 3;

    my ( $messages, $what, $flags ) = @_;
    $flags = ref $flags ? $flags : [$flags];

    return $self->bad_command("Invalid flag $_") for grep {not $self->connection->selected->can_set_flag($_)} @{$flags};

    my @messages = $self->connection->selected->get_uids($messages);
    $self->connection->ignore_flags(1) if $what =~ /\.SILENT$/i;
    for my $m (@messages) {
        $m->store( $what => $flags );
        $self->connection->_unsent_fetch->{$self->connection->sequence($m)}{UID}++
          unless $what =~ /\.SILENT$/i;
        cede;
    }
    $self->connection->ignore_flags(0) if $what =~ /\.SILENT$/i;

    $self->ok_completed;
}

sub copy {
    my $self = shift;
    
    return $self->bad_command("Not enough options") if @_ < 2;
    return $self->bad_command("Too many options") if @_ > 2;

    my ( $messages, $name ) = @_;
    my $mailbox = $self->connection->model->lookup( $name );
    return $self->no_command("[TRYCREATE] Mailbox does not exist") unless $mailbox;
    return $self->bad_command("Mailbox is read-only") if $mailbox->read_only;

    my @messages = $self->connection->selected->get_uids($messages);
    return $self->no_command("Permission denied") if grep {not $_->copy_allowed($mailbox)} @messages;

    my @new;
    for my $m (@messages) {
        push @new, $m->copy($mailbox);
        cede;
    }
    my $sequence = join(",",map {$_->uid} @messages);
    my $uids     = join(",",map {$_->uid} @new);
    $self->ok_command("[COPYUID @{[$mailbox->uidvalidity]} $sequence $uids] COPY COMPLETED");
}

sub expunge {
    my $self = shift;

    return $self->bad_command("Not enough options") if @_ < 1;
    return $self->bad_command("Too many options") if @_ > 2;

    return $self->bad_command("Mailbox is read-only") if $self->connection->selected->read_only;

    my ( $messages ) = @_;
    my @messages = $self->connection->selected->get_uids($messages);
    $self->connection->selected->expunge([map {$_->sequence} @messages]);

    $self->ok_completed;
}

sub search {
    my $self = shift;

    my $filter = Net::IMAP::Server::Command::Search::filter($self, @_);
    return unless $filter;

    my @results = map {$_->uid} grep {$filter->($_)} $self->connection->get_messages('1:*');
    $self->untagged_response(join(" ", SEARCH => @results));

    $self->ok_completed;
}

1;