package Net::IMAP::Server::Command::Search;

use warnings;
use strict;
use bytes;

use base qw/Net::IMAP::Server::Command/;
use DateTime::Format::Strptime;

sub validate {
    my $self = shift;

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

    return 1;
}

sub run {
    my $self = shift;

    my $filter = $self->filter($self->parsed_options);
    return unless $filter;

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

my $arg_parser = DateTime::Format::Strptime->new(pattern => "%e-%b-%Y");

sub filter {
    my $self = shift;
    my @tokens = [@_]; # This ref is intentional!  It gets us the top-level AND
    my $filters = []; my @stack;
    # TODO: CHARSET support
    while (@tokens) {
        my $token = shift @tokens;
        $token = uc $token unless ref $token;
        if ($token eq "ALL") {
            push @{$filters}, sub {1};
        } elsif ($token eq "ANSWERED") {
            push @{$filters}, sub {$_[0]->has_flag('\Answered')};
        } elsif ($token eq "BCC") {
            return $self->bad_command("Parse error") unless @tokens;
            my $bcc = shift @tokens;
            push @{$filters}, sub {$_[0]->mime->header("Bcc")||"" =~ /\Q$bcc\E/i};
        } elsif ($token eq "BEFORE") {
            return $self->bad_command("Parse error") unless @tokens;
            my $date = shift @tokens;
            my $parsed = $arg_parser->parse_datetime($date);
            return $self->bad_command("Bad date: $date") unless $parsed;
            push @{$filters}, sub {$_[0]->epoch_day_utc < $parsed->epoch };
        } elsif ($token eq "BODY") {
            return $self->bad_command("Parse error") unless @tokens;
            my $str = shift @tokens;
            push @{$filters}, sub {$_[0]->mime->body =~ /\Q$str\E/i};  # TODO: likely needs to recurse MIME parts?
        } elsif ($token eq "CC") {
            return $self->bad_command("Parse error") unless @tokens;
            my $cc = shift @tokens;
            push @{$filters}, sub {$_[0]->mime->header("Cc")||"" =~ /\Q$cc\E/i};
        } elsif ($token eq "DELETED") {
            push @{$filters}, sub {$_[0]->has_flag('\Deleted')};
        } elsif ($token eq "DRAFT") {
            push @{$filters}, sub {$_[0]->has_flag('\Draft')};
        } elsif ($token eq "FLAGGED") {
            push @{$filters}, sub {$_[0]->has_flag('\Flagged')};
        } elsif ($token eq "FROM") {
            return $self->bad_command("Parse error") unless @tokens;
            my $from = shift @tokens;
            push @{$filters}, sub {$_[0]->mime->header("From")||"" =~ /\Q$from\E/i};
        } elsif ($token eq "HEADER") {
            return $self->bad_command("Parse error") unless @tokens >= 2;
            my ($header, $value) = splice(@tokens, 0, 2);
            push @{$filters}, sub {$_[0]->mime->header($header)||"" =~ /\Q$value\E/i};
        } elsif ($token eq "KEYWORD") {
            return $self->bad_command("Parse error") unless @tokens;
            my $keyword = shift @tokens;
            push @{$filters}, sub {$_[0]->has_flag($keyword)};
        } elsif ($token eq "LARGER") {
            return $self->bad_command("Parse error") unless @tokens;
            my $size = shift @tokens;
            push @{$filters}, sub {length $_[0]->mime->as_string > $size};
        } elsif ($token eq "NEW") {
            push @{$filters}, sub {$_[0]->has_flag('\Recent') and not $_->has_flag('\Seen')};
        } elsif ($token eq "NOT") {
            unshift @stack, [NOT => 1 => $filters];
            my $negation = [];
            push @{$filters}, sub {not $negation->[0]->(@_)};
            $filters = $negation;
        } elsif ($token eq "OLD") {
            push @{$filters}, sub {not $_[0]->has_flag('\Recent')};
        } elsif ($token eq "ON") {
            return $self->bad_command("Parse error") unless @tokens;
            my $date = shift @tokens;
            my $parsed = $arg_parser->parse_datetime($date);
            return $self->bad_command("Bad date: $date") unless $parsed;
            push @{$filters}, sub {$_[0]->epoch_day_utc >= $parsed->epoch and $_[0]->epoch_day_utc < $parsed->epoch + 60*60*24 };
        } elsif ($token eq "OR") {
            unshift @stack, [OR => 2 => $filters];
            my $union = [];
            push @{$filters}, sub {$union->[0]->(@_) or $union->[1]->(@_)};
            $filters = $union;
        } elsif ($token eq "RECENT") {
            push @{$filters}, sub {$_[0]->has_flag('\Recent')};
        } elsif ($token eq "SEEN") {
            push @{$filters}, sub {$_[0]->has_flag('\Seen')};
        } elsif ($token eq "SENTBEFORE") {
            return $self->bad_command("Parse error") unless @tokens;
            my $date = shift @tokens;
            my $parsed = $arg_parser->parse_datetime($date);
            return $self->bad_command("Bad date: $date") unless $parsed;
            push @{$filters}, sub {my $e = $_[0]->date_day_utc; defined $e and $e->epoch < $parsed->epoch; };
        } elsif ($token eq "SENTON") {
            return $self->bad_command("Parse error") unless @tokens;
            my $date = shift @tokens;
            my $parsed = $arg_parser->parse_datetime($date);
            return $self->bad_command("Bad date: $date") unless $parsed;
            push @{$filters}, sub {my $e = $_[0]->date_day_utc; defined $e and $e->epoch >= $parsed->epoch and $e->epoch < $parsed->epoch + 60*60*24 };
        } elsif ($token eq "SENTSINCE") {
            return $self->bad_command("Parse error") unless @tokens;
            my $date = shift @tokens;
            my $parsed = $arg_parser->parse_datetime($date);
            return $self->bad_command("Bad date: $date") unless $parsed;
            push @{$filters}, sub {my $e = $_[0]->date_day_utc; defined $e and $e->epoch >= $parsed->epoch };
        } elsif ($token eq "SINCE") {
            return $self->bad_command("Parse error") unless @tokens;
            my $date = shift @tokens;
            my $parsed = $arg_parser->parse_datetime($date);
            return $self->bad_command("Bad date: $date") unless $parsed;
            push @{$filters}, sub {$_[0]->epoch_day_utc >= $parsed->epoch }
        } elsif ($token eq "SMALLER") {
            return $self->bad_command("Parse error") unless @tokens;
            my $size = shift @tokens;
            push @{$filters}, sub {length $_[0]->mime->as_string < $size};
        } elsif ($token eq "SUBJECT") {
            return $self->bad_command("Parse error") unless @tokens;
            my $subj = shift @tokens;
            push @{$filters}, sub {$_[0]->mime->header("Subject") =~ /\Q$subj\E/i};
        } elsif ($token eq "TEXT") {
            return $self->bad_command("Parse error") unless @tokens;
            my $str = shift @tokens;
            push @{$filters}, sub {$_[0]->mime->as_string =~ /\Q$str\E/i};
        } elsif ($token eq "TO") {
            return $self->bad_command("Parse error") unless @tokens;
            my $to = shift @tokens;
            push @{$filters}, sub {$_[0]->mime->header("To")||"" =~ /\Q$to\E/i};
        } elsif ($token eq "UID") {
            return $self->bad_command("Parse error") unless @tokens;
            my $set = shift @tokens;
            my %uids;
            $uids{$_->uid}++ for $self->connection->selected->get_uids($set);
            push @{$filters}, sub {$uids{$_[0]->uid}};
        } elsif ($token eq "UNANSWERED") {
            push @{$filters}, sub {not $_[0]->has_flag('\Answered')};
        } elsif ($token eq "UNDELETED") {
            push @{$filters}, sub {not $_[0]->has_flag('\Deleted')};
        } elsif ($token eq "UNDRAFT") {
            push @{$filters}, sub {not $_[0]->has_flag('\Draft')};
        } elsif ($token eq "UNFLAGGED") {
            push @{$filters}, sub {not $_[0]->has_flag('\Flagged')};
        } elsif ($token eq "UNKEYWORD") {
            return $self->bad_command("Parse error") unless @tokens;
            my $keyword = shift @tokens;
            push @{$filters}, sub {not $_[0]->has_flag($keyword)};
        } elsif ($token eq "UNSEEN") {
            push @{$filters}, sub {not $_[0]->has_flag('\Seen')};
        } elsif ($token =~ $self->connection->SEQUENCE_STRING) {
            my %uids;
            $uids{$_->uid}++ for $self->connection->get_messages($token);
            push @{$filters}, sub {$uids{$_[0]->uid}};
        } elsif (ref $token) {
            unshift @stack, [AND => -1 => $filters, \@tokens];
            @tokens = @{$token};
            my $intersection = [];
            push @{$filters}, sub {
                for my $f (@{$intersection}) {
                    return unless $f->(@_);
                }
                return 1;
            };
            $filters = $intersection;
        } else {
            return $self->bad_command("Unknown search token: $token");
        }

        while (@stack and (@{$filters} == $stack[0][1] or ($stack[0][3] and not @tokens))) {
            $filters = $stack[0][2];
            @tokens = @{$stack[0][3]} if $stack[0][3];
            shift @stack;
        }
    }

    return $self->bad_command("Unclosed NOT/OR") if @stack;
    
    return shift @{$filters};
}

sub send_untagged {
    my $self = shift;

    $self->SUPER::send_untagged( expunged => 0 );
}

1;