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::Misc qw/concat get_perms explode must_attrs email_valid/;
use Email::Valid;


=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 => $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;
    }
    return map { { domain => $_->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 = shift;
    my %options = @_;
    my $concat = $options{'-concat'};

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

    # 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->get_value('fvd')
           , isactive => $domain->get_value('fripostIsStatusActive') eq 'TRUE'
           , description => concat($concat, $domain->get_value('description'))
           , catchalls => concat($concat, $domain->get_value('fripostOptionalMaildrop'))
           , permissions => get_perms($domain, $self->whoami)
           )
}


=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/) {
        $d->{$_} = explode ($options{'-concat'}, $d->{$_})
            if defined $d->{$_};
    }

    eval {
        &_is_valid($d);
        my $mesg = $self->ldap->modify(
                       'fvd='.$d->{domain}.','.$self->suffix,
                       replace => { fripostIsStatusActive => $d->{isactive} ?
                                        'TRUE' : 'FALSE'
                                  , description => $d->{description}
                                  , fripostOptionalMaildrop => $d->{catchalls}
                   } );
        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/ );
    email_valid( $d->{domain}, -prefix => 'fake@', -error => 'Invalid domain',
                               -exact => 1 );
    $d->{catchalls} = [ map { email_valid($_) } @{$d->{catchalls}} ];
}


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