package Net::IMAP::Server::Mailbox;

use warnings;
use strict;

use Net::IMAP::Server::Message;
use base 'Class::Accessor';

__PACKAGE__->mk_accessors(
    qw(is_inbox parent children _path uidnext uids uidvalidity messages subscribed is_selectable)
);

=head1 NAME

Net::IMAP::Server::Mailbox - A user's view of a mailbox

=head1 DESCRIPTION

This class encapsulates the view of messages in a mailbox.  You may
wish to subclass this class in order to source our messages from, say,
a database.

=head1 METHODS

=head2 Initialization

=head3 new

Creates a new mailbox; returns C<undef> if a mailbox with the same
full path already exists.  It calls L</init>, then L</load_data>.

=cut

sub new {
    my $class = shift;
    my $self  = $class->SUPER::new(@_);
    return
        if $self->parent
        and grep { $self->full_path eq $_->full_path }
        @{ $self->parent->children };
    $self->is_inbox(1)
        if $self->parent
        and not $self->parent->parent
        and $self->name =~ /^inbox$/i;
    $self->init;
    $self->load_data;
    return $self;
}

=head3 init

Sets up basic properties of the mailbox:

=over

=item *

L</uidnext> is set to 1000

=item *

L</messages> and L</uids> are initialized to an empty list reference
and an empty hash reference, respectively.

=item *

L</children> is set to an empty list reference.

=item *

L</uidvalidity> is set to the number of seconds since the epoch.

=item *

L</subscribed> and L</is_selectable> are set true.

=back

=cut

sub init {
    my $self = shift;
    $self->uidnext(1000);
    $self->messages( [] );
    $self->uids( {} );
    $self->children( [] );
    $self->uidvalidity(time);
    $self->subscribed(1);
    $self->is_selectable(1);
}

=head3 load_data

This default mailbox implementation simply returns an empty mailbox.
Subclasses will probably wish to override this method.

=cut

sub load_data {
}

=head3 name

Gets or sets the name of the mailbox.  This includes a workaround for
Zimbra, which doesn't understand mailbox names with colons in them --
so we substitute dashes.

=cut

sub name {
    my $self = shift;
    if (@_) {
        $self->{name} = shift;
    }

    # Zimbra can't handle mailbox names with colons in them, for no
    # obvious reason.  Handily, it identifies itself as Zimbra before
    # login, so we know when to perform a colonoscopy.  We do this on
    # get, and not on set, because the same model might be used by
    # other clients.
    my $name = $self->{name};
    $name =~ s/:+/-/g
        if Net::IMAP::Server->connection
        and exists Net::IMAP::Server->connection->client_id->{vendor}
        and Net::IMAP::Server->connection->client_id->{vendor} eq "Zimbra";

    return $name;
}

=head2 Actions

=head3 poll

Called when the server wishes the mailbox to update its state.  By
default, does nothing.  Subclasses will probably wish to override this
method.

=cut

sub poll { }

=head3 add_message MESSAGE

Adds the gven L<Net::IMAP::Server::Message> C<MESSAGE> to the mailbox,
setting its L<Net::IMAP::Server::Message/sequence> and
L<Net::IMAP::Server::Message/mailbox>.
L<Net::IMAP::Server::Message/uid> is set to L</uidnext> if the message
does not already have a C<uid>.

=cut

sub add_message {
    my $self    = shift;
    my $message = shift;

    # Basic message setup first
    $message->mailbox($self);
    $message->sequence( @{ $self->messages } + 1 );
    push @{ $self->messages }, $message;

    # Some messages may supply their own uids
    if ( $message->uid ) {
        $self->uidnext( $message->uid + 1 )
            if $message->uid >= $self->uidnext;
    } else {
        $message->uid( $self->uidnext );
        $self->uidnext( $self->uidnext + 1 );
    }
    $self->uids->{ $message->uid } = $message;

    # Also need to add it to anyone that has this folder as a
    # temporary message store
    for my $c ( Net::IMAP::Server->concurrent_mailbox_connections($self) ) {
        next unless $c->temporary_messages;

        push @{ $c->temporary_messages }, $message;
        $c->temporary_sequence_map->{$message}
            = scalar @{ $c->temporary_messages };
    }
    return $message;
}

=head3 add_child [...]

Creates a mailbox under this mailbox, of the same class as this
mailbox is.  Any arguments are passed to L</new>.  Returns the newly
added subfolder, or undef if a folder with that name already exists.

=cut

sub add_child {
    my $self = shift;
    my $node = ( ref $self )->new( { @_, parent => $self } );
    return unless $node;
    push @{ $self->children }, $node;
    return $node;
}

=head3 create [...]

Identical to L</add_child>.  Should return false if the create is
denied or fails.

=cut

sub create {
    my $self = shift;
    return $self->add_child(@_);
}

=head3 reparent MAILBOX

Reparents this mailbox to be a child of the given
L<Net::IMAP::Server::Mailbox> C<MAILBOX>.  Shold return 0 if the
reparenting is denied or fails.

=cut

sub reparent {
    my $self   = shift;
    my $parent = shift;

    $self->parent->children(
        [ grep { $_ ne $self } @{ $self->parent->children } ] );
    push @{ $parent->children }, $self;
    $self->parent($parent);
    return 1 unless Net::IMAP::Server->connection;

    my @uncache = ($self);
    while (@uncache) {
        my $o = shift @uncache;
        delete Net::IMAP::Server->connection->{path_cache}{$o.""};
        push @uncache, @{ $o->children };
    }
    return 1;
}

=head3 delete

Deletes this mailbox, removing it from its parent's list of children.
Should return false if the deletion is denied or fails.

=cut

sub delete {
    my $self = shift;
    $self->parent->children(
        [ grep { $_ ne $self } @{ $self->parent->children } ] );

    return 1;
}

=head3 expunge [ARRAYREF]

Expunges messages marked as C<\Deleted>.  If an arrayref of message
sequence numbers is provided, only expunges message from that set.

=cut

sub expunge {
    my $self = shift;
    my $only = shift;
    return if $only and not @{$only};
    my %only;
    $only{$_}++ for @{ $only || [] };

    my @ids;
    my $offset   = 0;
    my @messages = @{ $self->messages };
    $self->messages(
        [   grep {
                not( $_->has_flag('\Deleted')
                    and ( not $only or $only{ $_->sequence } ) )
                } @messages
        ]
    );
    for my $c ( Net::IMAP::Server->concurrent_mailbox_connections($self) ) {

        # Ensure that all other connections with this selected get a
        # temporary message list, if they don't already have one
        unless (
                # Except if we find our own connection; if this is
                # *not* part of a poll, we asked for it, so no need to
                # set up temporary messages.
            ( Net::IMAP::Server->connection and
              $c eq Net::IMAP::Server->connection
              and not $c->in_poll
            )
            or $c->temporary_messages
            )
        {
            $c->temporary_messages( [@messages] );
            $c->temporary_sequence_map( {} );
            $c->temporary_sequence_map->{$_} = $_->sequence for @messages;
        }
    }

    for my $m (@messages) {
        if ( $m->has_flag('\Deleted')
            and ( not $only or $only{ $m->sequence } ) )
        {
            push @ids, $m->sequence - $offset;
            delete $self->uids->{ $m->uid };
            $offset++;
            $m->expunge;
        } elsif ($offset) {
            $m->sequence( $m->sequence - $offset );
        }
    }

    for my $c ( Net::IMAP::Server->concurrent_mailbox_connections($self) ) {

        # Also, each connection gets these added to their expunge list
        push @{ $c->untagged_expunge }, @ids;
    }

    return 1;
}

=head3 append MESSAGE

Appends, and returns, the given C<MESSAGE>, which should be a string
containing the message.  Returns false is the append is denied or
fails.

=cut

sub append {
    my $self = shift;
    my $m    = Net::IMAP::Server::Message->new(@_);
    $m->set_flag( '\Recent', 1 );
    $self->add_message($m);
    return $m;
}

=head3 status

=cut

sub status {
    my $self = shift;
    my (@keys) = @_;
    $self->poll;
    my %items;
    for my $i ( @keys ) {
        if ( $i eq "MESSAGES" ) {
            $items{$i} = $self->exists;
        } elsif ( $i eq "RECENT" ) {
            $items{$i} = $self->recent;
        } elsif ( $i eq "UNSEEN" ) {
            my $unseen = $self->unseen;
            $items{$i} = $unseen if defined $unseen;
        } elsif ( $i eq "UIDVALIDITY" ) {
            my $uidvalidity = $self->uidvalidity;
            $items{$i} = $uidvalidity if defined $uidvalidity;
        } elsif ( $i eq "UIDNEXT" ) {
            my $uidnext = $self->uidnext;
            $items{$i} = $uidnext if defined $uidnext;
        }
    }
    return %items;
}

=head3 close

Called when the client selects a different mailbox, or when the
client's connection closes.  By default, does nothing.

=cut

sub close { }

=head2 Inspection

=head3 separator

Returns the path separator.  Note that only the path separator of the
root mailbox matters.  Defaults to a forward slash.

=cut

sub separator {
    return "/";
}

=head3 full_path

Returns the full path to this mailbox.

=cut

sub full_path {
    my $self = shift;
    my $cache
        = Net::IMAP::Server->connection
        ? ( Net::IMAP::Server->connection->{path_cache} ||= {} )
        : {};
    return $cache->{$self.""}
      if defined $cache->{$self.""};
    $cache->{$self.""} =
          !$self->parent         ? ""
        : !$self->parent->parent ? $self->name
        : $self->parent->full_path . $self->separator . $self->name;
    return $cache->{$self.""};
}

=head3 flags

Returns the list of flags that this mailbox supports.

=cut

sub flags {
    my $self = shift;
    return qw(\Answered \Flagged \Deleted \Seen \Draft);
}

=head3 can_set_flag FLAG

Returns true if the client is allowed to set the given flag in this
mailbox; this simply scans L</flags> to check.

=cut

sub can_set_flag {
    my $self = shift;
    my $flag = shift;

    return 1 if grep { lc $_ eq lc $flag } $self->flags;
    return;
}

=head3 exists

Returns the number of messages in this mailbox.  Observing this also
sets the "high water mark" for notifying the client of messages added.

=cut

sub exists {
    my $self = shift;
    Net::IMAP::Server->connection->previous_exists(
        scalar @{ $self->messages } )
        if $self->selected;
    return scalar @{ $self->messages };
}

=head3 recent

Returns the number of messages which have the C<\Recent> flag set.

=cut

sub recent {
    my $self = shift;
    return scalar grep { $_->has_flag('\Recent') } @{ $self->messages };
}

=head3 unseen

Returns the number of messages which do not have the C<\Seen> flag set.

=cut

sub unseen {
    my $self = shift;
    return scalar grep { not $_->has_flag('\Seen') } @{ $self->messages };
}

=head3 permanentflags

Returns the flags which will be stored permanently for this mailbox;
defaults to the same set as L</flags> returns.

=cut

sub permanentflags {
    my $self = shift;
    return $self->flags;
}

=head3 read_only

Returns true if this mailbox is read-only.  By default, always returns
false.

=cut

sub read_only {
    my $self = shift;
    return 0;
}

=head3 selected

Returns true if this mailbox is the mailbox selected by the current
L<Net::IMAP::Server::Connection>.

=cut

sub selected {
    my $self = shift;
    return Net::IMAP::Server->connection
      and Net::IMAP::Server->connection->selected
        and Net::IMAP::Server->connection->selected eq $self;
}

=head3 get_uids STR

Parses and returns messages fitting the given UID range.

=cut

sub get_uids {
    my $self = shift;
    my $str  = shift;

    # Otherwise $self->messages->[-1] explodes
    return () unless @{$self->messages};

    my %ids;
    for ( split ',', $str ) {
        if (/^(\d+):(\d+)$/) {
            $ids{$_}++ for $2 > $1 ? $1 .. $2 : $2 .. $1;
        } elsif ( /^(\d+):\*$/ or /^\*:(\d+)$/ ) {
            $ids{$_}++
                for $self->messages->[-1]->uid,
                $1 .. $self->messages->[-1]->uid;
        } elsif (/^(\d+)$/) {
            $ids{$1}++;
        } elsif (/^\*$/) {
            $ids{ $self->messages->[-1]->uid }++;
        }
    }
    return
        grep {defined} map { $self->uids->{$_} } sort { $a <=> $b } keys %ids;
}

=head3 get_messages STR

Parses and returns messages fitting the given sequence range.  Note
that since sequence numbers are connection-dependent, this simply
passes the buck to L</Net::IMAP::Server::Connection/get_messages>.

=cut

sub get_messages {
    my $self = shift;
    return () unless Net::IMAP::Server->connection;
    return Net::IMAP::Server->connection->get_messages(@_);
}

=head3 update_tree

Called before the model's children are listed to the client.  This is
the right place to hook into for mailboxes whose children shift with
time.

=cut

sub update_tree {
    my $self = shift;
    $_->update_tree for @{ $self->children };
}

=head3 prep_for_destroy

Called before the mailbox is destroyed; this deals with cleaning up
the several circular references involved.  In turn, it calls
L</prep_for_destroy> on all child mailboxes, as well as all messages
it has.

=cut

sub prep_for_destroy {
    my $self = shift;
    my @kids = @{ $self->children || [] };
    $self->children( [] );
    $_->prep_for_destroy for @kids;
    my @messages = @{ $self->messages || [] };
    $self->messages( [] );
    $self->uids( {} );
    $_->prep_for_destroy for @messages;
    $self->parent(undef);
}

1;