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

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)
);

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;
}

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

sub load_data {
}

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;
}

sub poll { }

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;
}

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

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

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

    $self->parent->children(
        [ grep { $_ ne $self } @{ $self->parent->children } ] );
    push @{ $parent->children }, $self;
    $self->parent($parent);
    $self->name(shift) if @_;
    $self->full_path( purge => 1 );
    return 1;
}

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

    return 1;
}

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->_unsent_expunge }, @ids;
    }

    return 1;
}

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

sub close { }

sub separator {
    return "/";
}

sub full_path {
    my $self = shift;
    my %args = @_;
    my $cache
        = Net::IMAP::Server->connection
        ? ( Net::IMAP::Server->connection->{path_cache} ||= {} )
        : {};

    if ($args{purge}) {
        my @uncache = ($self);
        while (@uncache) {
            my $o = shift @uncache;
            delete $cache->{$o.""};
            push @uncache, @{ $o->children };
        }
    }

    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.""};
}

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

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

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

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

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

sub first_unseen {
    my $self = shift;
    for ( @{ $self->messages } ) {
        next if $_->has_flag('\Seen');
        return Net::IMAP::Server->connection
            ? Net::IMAP::Server->connection->sequence($_)
            : $_->sequence;
    }
    return 0;
}

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

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

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" ) {
            $items{$i} = $self->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;
}

sub read_only {
    my $self = shift;
    return unless Net::IMAP::Server->connection;
    return $self->selected
        && Net::IMAP::Server->connection->selected_read_only;
}

sub select {}

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

sub _uids_in_range {
    my $self = shift;
    my ( $low, $high ) = @_;
    ( $low, $high ) = ( $high, $low ) if $low > $high;

    my $count = scalar @{ $self->messages };
    if ( $high - $low > $count ) {

        # More UIDs to enumerate than we actually have; check each
        # existing UID for being in the range
        return grep {$_ >= $low and $_ <= $high} map $_->uid, @{ $self->messages };
    } else {

        # More messages than in the UID range; enumerate the range and
        # check each against UIDs which exist
        my $uids = $self->uids;
        return grep {defined $uids->{$_}} $low .. $high;
    }
}

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

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

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

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

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

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;