package Fripost::Schema::Mailbox;

=head1 NAME

Mailbox.pm -

=head1 DESCRIPTION

Mailbox.pm abstracts the LDAP schema definition and provides methods to
add, list or delete virtual mailboxes.

=cut

use 5.010_000;
use strict;
use warnings;
use utf8;

use parent 'Fripost::Schema';
use Fripost::Schema::Misc qw/concat explode must_attrs email_valid/;
use Net::IDN::Encode qw/domain_to_ascii
                        email_to_ascii email_to_unicode/;


=head1 METHODS

=over 4

=item B<search> (I<domain>, I<OPTIONS>)

List every known (and visible) mailbox under the given domain. The
output is a array of hash references, sorted by mailbox.

=cut

sub search {
    my $self = shift;
    my $d = domain_to_ascii(shift);
    my %options = @_;
    my $concat = $options{'-concat'};

    my $mailboxes = $self->ldap->search(
                        base => "fvd=$d,".$self->suffix,
                        scope => 'one',
                        deref => 'never',
                        filter => 'objectClass=FripostVirtualMailbox',
                        attrs => [ qw/fvu description fripostIsStatusActive
                                      fripostOptionalMaildrop
                                      fripostMailboxQuota/ ]
                  );
    if ($mailboxes->code) {
        die $options{'-die'}."\n" if defined $options{'-die'};
        die $mailboxes->error."\n";
    }
    return map { { user => email_to_unicode($_->get_value('fvu'))
                 , isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
                 , description => concat($concat, $_->get_value('description'))
                 , forwards => concat($concat, map { email_to_unicode($_) }
                                               $_->get_value('fripostOptionalMaildrop'))
                 , quota => $_->get_value('fripostMailboxQuota') // undef
                 }
               }
               $mailboxes->sorted('fvu')
}


=item B<replace> (I<mailbox>, I<OPTIONS>)

Replace an existing account with the given one.

=cut

sub replace {
    my $self = shift;
    my $m = shift;
    my %options = @_;

    foreach (qw/description forwards/) {
        $m->{$_} = explode ($options{'-concat'}, $m->{$_})
            if defined $m->{$_};
    }

    eval {
        my ($l,$d) = split /\@/, email_to_ascii($m->{user}), 2;
        &_is_valid($m);
        my $mesg = $self->ldap->modify(
                       "fvu=$l,fvd=$d,".$self->suffix,
                       replace => { fripostIsStatusActive => $m->{isactive} ?
                                        'TRUE' : 'FALSE'
                                  , description => $m->{description}
                                  , fripostOptionalMaildrop => $m->{forwards}
                   } );
        die $mesg->error."\n" if $mesg->code;
    };
    return $@;
}


=item B<passwd> (I<username>, I<password>, I<OPTIONS>)

Change the password of the given user. I<password> is used raw, so you
may want to hash it before hand.

=cut

sub passwd {
    my $self = shift;
    my ($l,$d) = split /\@/, email_to_ascii(shift), 2;
    my $pw = shift;
    my %options = @_;

    my $mesg = $self->ldap->modify(
                   "fvu=$l,fvd=$d,".$self->suffix,
                   replace => { userPassword => $pw } );
    return "Cannot change password" if $mesg->code;
}



=item B<add> (I<mailbox>, I<OPTIONS>)

Add the given account.

=cut

sub add {
    my $self = shift;
    my $m = shift;
    my %options = @_;

    foreach (qw/description forwards/) {
        $m->{$_} = explode ($options{'-concat'}, $m->{$_})
            if defined $m->{$_};
    }

    eval {
        my ($l,$d) = split /\@/, email_to_ascii($m->{user}), 2;
        die "Missing user name\n" if $l eq '';
        &_is_valid($m);
        die "‘".$m->{user}."’ already exists\n"
            if $self->local->exists($m->{user},%options);

        my %attrs = ( objectClass => 'FripostVirtualMailbox'
                    , fripostIsStatusActive => $m->{isactive} ? 'TRUE' : 'FALSE'
                    , userPassword => $m->{password}
                    );
        $attrs{description} = $m->{description}
            if defined $m->{description} and @{$m->{description}};
        $attrs{fripostMailboxQuota} = $m->{quota} if defined $m->{quota};
        $attrs{fripostOptionalMaildrop} = $m->{forwards}
            if defined $m->{forwards} and @{$m->{forwards}};

        my $mesg = $self->ldap->add( "fvu=$l,fvd=$d,".$self->suffix,
                                     attrs => [ %attrs ] );
        if ($mesg->code) {
            die $options{'-die'}."\n" if defined $options{'-die'};
            die $mesg->error."\n";
        }
    };
    return $@;
}


=item B<delete> (I<mailbox>, I<OPTIONS>)

Delete the given mailbox. Note: this will NOT wipe the mailbox off the
disk, but merely delete its entry in the LDAP directory.

=cut

sub delete {
    my $self = shift;
    my ($l,$d) = split /\@/, email_to_ascii(shift), 2;
    my %options = @_;

    my $mesg = $self->ldap->delete( "fvu=$l,fvd=$d,".$self->suffix );
    if ($mesg->code) {
        if (defined $options{'-die'}) {
            return $mesg->error unless $options{'-die'};
            die $options{'-die'}."\n";
        }
        die $mesg->error."\n";
    }
}


=back

=head1 GLOBAL OPTIONS

If the B<-concat> option is present, it will intersperse multi-valued
attributes. Otherwise, an array reference containing every values will
be returned for these attributes.

The B<-die> option, if present, overides LDAP croaks and errors.

=cut


# Ensure that the given mailbox is valid.
sub _is_valid {
    my $m = shift;
    must_attrs( $m, qw/user isactive/ );
    $m->{user} = email_valid( $m->{user}, -exact => 1);
    $m->{forwards} = [ map { email_valid($_) } @{$m->{forwards}} ];
    # TODO: match 'quota' against the Dovecot specifications
}


=head1 AUTHOR

Guilhem Moulin C<< <guilhem at fripost.org> >>

=head1 COPYRIGHT

Copyright 2012 Guilhem Moulin.

=head1 LICENSE

This program is free software; you can redistribute it and/or modify it
under the same terms as perl itself.

=cut

1;

__END__