package Fripost::Schema::Alias;

=head1 NAME

Alias.pm -

=head1 DESCRIPTION

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

=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) alias under the given domain. The output
is a array of hash references, sorted by alias.

=cut

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

    my $aliases = $self->ldap->search(
                      base => "fvd=$domain,".$self->suffix,
                      scope => 'one',
                      deref => 'never',
                      filter => 'objectClass=FripostVirtualAlias',
                      attrs => [ qw/fva description fripostIsStatusActive
                                    fripostMaildrop/ ]
                  );
    if ($aliases->code) {
        die $options{'-die'}."\n" if defined $options{'-die'};
        die $aliases->error."\n";
    }
    return map { { alias => email_to_unicode($_->get_value('fva'))
                 , isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
                 , description => concat($concat, $_->get_value('description'))
                 , maildrop => concat($concat, map { email_to_unicode ($_) }
                                                   $_->get_value('fripostMaildrop'))
                 }
               }
               $aliases->sorted('fva')
}


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

Replace an existing alias with the given one.

=cut

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

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

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


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

Add the given alias.

=cut

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

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

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

        my %attrs = ( objectClass => 'FripostVirtualAlias'
                    , fripostIsStatusActive => $a->{isactive} ? 'TRUE' : 'FALSE'
                    , fripostMaildrop => $a->{maildrop}
                    , fripostOwner => $self->whoami
                    );
        $attrs{description} = $a->{description}
            if defined $a->{description} and @{$a->{description}};

        my $mesg = $self->ldap->add( "fva=$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<alias>, I<OPTIONS>)

Delete the given alias.

=cut

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

    my $mesg = $self->ldap->delete( "fva=$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 alias is valid.
sub _is_valid {
    my $a = shift;
    must_attrs( $a, qw/alias isactive maildrop/ );
    $a->{alias} = email_valid( $a->{alias}, -exact => 1 );
    $a->{maildrop} = [ map { email_valid($_) } @{$a->{maildrop}} ];
    # TODO: check for cycles?
}


=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__