package Net::IMAP::Server::DefaultModel;

use warnings;
use strict;

use base 'Class::Accessor';
__PACKAGE__->mk_accessors(qw(auth root));

use Net::IMAP::Server::Mailbox;

use Encode;
use Encode::IMAPUTF7;

my %roots;

=head1 NAME

Net::IMAP::Server::DefaultModel - Encapsulates per-connection
information about the layout of IMAP folders.

=head1 DESCRIPTION

This class represents an abstract model backend to the IMAP server; it
it meant to be overridden by server implementations.  Primarily,
subclasses are expected to override L</init> to set up their folder
structure.

Methods in the model can C<die> with messages which start with "NO" or
"BAD", which will be propagated back to the client immediately.  See
L<Net::IMAP::Server::Connection/handle_command>.

=head1 METHODS

=head2 new

This class is created when the client has successfully authenticated
to the server.

=cut

sub new {
    my $class = shift;
    my $self  = $class->SUPER::new(@_);
    $self->init;
    return $self;
}

=head2 init

Called when the class is instantiated, with no arguments.  Subclasses
should override this method to inspect the L</auth> object, and
determine what folders the user should have.  The primary purpose of
this method is to set L</root> to the top level of the mailbox tree.
The root is expected to contain a mailbox named C<INBOX>.

=cut

sub init {
    my $self = shift;
    my $user = $self->auth->user || 'default';

    if ( $roots{$user} ) {
        $self->root( $roots{$user} );
    } else {
        $self->root( Net::IMAP::Server::Mailbox->new() )
            ->add_child( name => "INBOX" )
            ->add_child( name => $user );
        $roots{$user} = $self->root;
    }

    return $self;
}

=head2 root MAILBOX

Gets or sets the root L<Net::IMAP::Server::Mailbox> for this model.
The root mailbox should contain no messages, and have no name -- it
exists purely to contain sub-mailboxes, like C<INBOX>.  The L</init>
method is responsible for setting up the appropriate root mailbox, and
all sub-mailboxes for the model.

=head2 auth

Returns the L<Net::IMAP::Server::DefaultAuth> object for this model;
this is set by the connection when the model is created, and will
always reference a valid authentication object.

=head2 close

Called when this model's connection closes, for any reason.  By
default, does nothing.

=cut

sub close {
}

=head2 split PATH

Utility method which splits a given C<PATH> according to the mailbox
separator, as determined by the
L<Net::IMAP::Server::Mailbox/separator> of the L</root>.  May C<die>
if the path (which is expected to be encoded using IMAP-UTF-7) is
invalid.  See L<Encode::IMAPUTF7>. If the mailbox hierarchy is flat
(i.e. the separator is undef), returns the name without change.

=cut

sub split {
    my $self = shift;
    my $name = shift;

    $name = eval { Encode::decode('IMAP-UTF-7', $name) };
    die "BAD Invalid UTF-7 encoding\n" unless defined $name;

    if (defined $self->root->separator) {
        return grep {length} split quotemeta $self->root->separator, $name;
    } else {
        return $name;
    }
}

=head2 lookup PATH

Given a C<PATH>, returns the L<Net::IMAP::Server::Mailbox> for that
path, or undef if none matches.  May die if the path contains unvalid
IMAP-UTF-7 (see L</split>).

=cut

sub lookup {
    my $self  = shift;
    my $name  = shift;
    my @parts = $self->split($name);
    my $part  = $self->root;
    return undef unless @parts;
    while (@parts) {
        return undef unless @{ $part->children };
        my $find = shift @parts;
        my @match
            = grep { $_->is_inbox ? uc $find eq "INBOX" : $_->name eq $find }
            @{ $part->children };
        return undef unless @match;
        $part = $match[0];
    }
    return $part;
}

=head2 namespaces

Returns the namespaces of this model, per RFC 2342.  Defaults to
"INBOX" being the personal namespace, with no "shared" or "other
users" namespaces.

=cut

sub namespaces {
    my $self = shift;
    return ([["" => $self->root->separator]], undef, undef);
}

1;