package Fripost::Schema::Domain;

=head1 NAME

Domain.pm -

=head1 DESCRIPTION

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

=cut

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

use parent 'Fripost::Schema';
use Fripost::Schema::Util qw/concat get_perms explode must_attrs
                             email_valid canonical_dn/;
use Net::IDN::Encode qw/domain_to_ascii domain_to_unicode
                        email_to_ascii email_to_unicode/;


=head1 METHODS

=over 4

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

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

=cut

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

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


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

Returns a hash with all the (visible) attributes for the given domain.

=cut

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

    my $domains = $self->ldap->search(
                      base => canonical_dn({fvd => $d}, @{$self->suffix}),
                      scope => 'base',
                      deref => 'never',
                      filter => 'objectClass=FripostVirtualDomain',
                      attrs => [ qw/fvd description
                                    fripostIsStatusActive
                                    fripostOptionalMaildrop
                                    fripostCanAddAlias
                                    fripostCanAddList
                                    fripostOwner
                                    fripostPostmaster/ ]
                  );
    if ($domains->code) {
        die $options{'-die'}."\n" if defined $options{'-die'};
        die $domains->error."\n";
    }

    # The following is not supposed to happen.
    die "Error: Multiple matching entries found." if $domains->count > 1;
    my $domain = $domains->pop_entry;
    unless (defined $domain) {
        die $options{'-die'}."\n" if defined $options{'-die'};
        die "No such such domain: ‘$d’\n";
    }

    return ( domain => domain_to_unicode($domain->get_value('fvd'))
           , isactive => $domain->get_value('fripostIsStatusActive') eq 'TRUE'
           , description => concat($concat, $domain->get_value('description'))
           , catchalls => concat($concat, map { &_email_to_unicode ($_) }
                                              $domain->get_value('fripostOptionalMaildrop'))
           , permissions => get_perms($domain, $self->whoami)
           , canAddAlias => concat($concat, map { &_email_to_unicode ($self->_dn2fvu($_)) }
                                               $domain->get_value('fripostCanAddAlias'))
           , canAddList => concat($concat, map { &_email_to_unicode ($self->_dn2fvu($_)) }
                                              $domain->get_value('fripostCanAddList'))
           )
}


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

Replace an existing domain with the given one.

=cut

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

    foreach (qw/description catchalls canAddAlias canAddList/) {
        $d->{$_} = explode ($options{'-concat'}, $d->{$_})
            if defined $d->{$_};
    }

    eval {
        &_is_valid($d);
        my $dn = canonical_dn( {fvd => $d->{domain}}, @{$self->suffix} );
        my $mesg = $self->ldap->modify( $dn,
                       replace => { fripostIsStatusActive => $d->{isactive} ?
                                        'TRUE' : 'FALSE'
                                  , description => $d->{description}
                                  , fripostOptionalMaildrop => $d->{catchalls}
                                  , fripostCanAddAlias =>
                                          [ map $self->_fvu2dn($_),
                                                @{$d->{canAddAlias}} ]
                                  , fripostCanAddList =>
                                          [ map $self->_fvu2dn($_),
                                                @{$d->{canAddList}} ]
                   } );
        die $mesg->error."\n" if $mesg->code;
    };
    return $@;
}


sub add {
    die "TODO";
}

=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 domain is valid.
sub _is_valid {
    my $d = shift;
    must_attrs( $d, qw/domain isactive/ );
    $d->{domain} = email_valid( $d->{domain}, -prefix => 'fake@',
                                              -error => 'Invalid domain',
                                              -exact => 1 );
    $d->{catchalls} = [ map { email_valid($_, -prefix => 'fake') }
                            @{$d->{catchalls}} ];
    $d->{canAddAlias} = [ map { email_valid($_, -prefix => 'fake') }
                                 @{$d->{canAddAlias}} ];
    $d->{canAddList} = [ map { email_valid($_, -prefix => 'fake') }
                                @{$d->{canAddList}} ];
}


# A variant of email_to_unicode that also takes care of domain aliases.
sub _email_to_unicode {
    my $email = shift;
    return '@'.domain_to_unicode($email) if $email =~ s/^\@//;
    return email_to_unicode($email);
}


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