package Fripost::Schema::User;

=head1 NAME

User.pm -

=head1 DESCRIPTION

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

=cut

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

use parent 'Fripost::Schema';
use Fripost::Schema::Util qw/concat explode must_attrs email_valid
                             split_addr canonical_dn/;
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) user under the given domain. The
output is a array of hash references, sorted by user.

=cut

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

    my $users = $self->ldap->search(
                    base => canonical_dn( {fvd => $d}, @{$self->suffix} ),
                    scope => 'one',
                    deref => 'never',
                    filter => 'objectClass=FripostVirtualUser',
                    attrs => [ qw/fvu description fripostIsStatusActive
                                  fripostOptionalMaildrop
                                  fripostUserQuota/ ]
                );
    if ($users->code) {
        die $options{'-die'}."\n" if defined $options{'-die'};
        die $users->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('fripostUserQuota') // undef
                 }
               }
               $users->sorted('fvu')
}


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

Replace an existing account with the given one.

=cut

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

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

    eval {
        my ($l,$d) = split_addr( $u->{user}, -encode => 'ascii' );
        &_is_valid($u);
        my $mesg = $self->ldap->modify(
                       canonical_dn( {fvu => $l}, {fvd => $d}, @{$self->suffix} ),
                       replace => { fripostIsStatusActive => $u->{isactive} ?
                                        'TRUE' : 'FALSE'
                                  , description => $u->{description}
                                  , fripostOptionalMaildrop => $u->{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_addr( shift, -encode => 'ascii' );
    my $pw = shift;
    my %options = @_;

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



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

Add the given account.

=cut

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

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

    eval {
        die "Missing user name\n" unless $u->{user} =~ /^.+\@.+$/;
        my ($l,$d) = split_addr( $u->{user}, -encode => 'ascii' );
        &_is_valid($u);
        die "‘".$u->{user}."’ already exists\n"
            if $self->local->exists($u->{user},%options);

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

        my $mesg = $self->ldap->add(
                       canonical_dn( {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<user>, I<OPTIONS>)

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

=cut

sub delete {
    my $self = shift;
    my ($l,$d) = split_addr( shift, -encode => 'ascii' );
    my %options = @_;

    my $mesg = $self->ldap->delete( canonical_dn( {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 user is valid.
sub _is_valid {
    my $u = shift;
    must_attrs( $u, qw/user isactive/ );
    $u->{user} = email_valid( $u->{user}, -exact => 1);
    $u->{forwards} = [ map { email_valid($_) } @{$u->{forwards}} ];
    # TODO: match 'quota' against the Dovecot specifications
}


=head1 AUTHOR

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

=head1 COPYRIGHT

Copyright 2012,2013 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__