package Fripost::Schema::List;

=head1 NAME

List.pm -

=head1 DESCRIPTION

List.pm abstracts the LDAP schema definition and provides methods to
add, list or delete virtual mailing lists.

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

=cut

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

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


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

Replace an existing list with the given one.

=cut

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

    $l->{description} = explode ($options{'-concat'}, $l->{description})
        if defined $l->{description};

    eval {
        my ($l2,$d) = split /\@/, email_to_ascii($l->{list}), 2;
        &_is_valid($l);
        my $l3 = { fripostIsStatusActive => $l->{isactive} ? 'TRUE' : 'FALSE'
                 , description => $l->{description} };
        $l3->{fripostListManager} = $l->{transport} if defined $l->{transport};
        my $mesg = $self->ldap->modify(
                       "fvl=$l2,fvd=$d,".$self->suffix,
                       replace => $l3 );
        die $mesg->error."\n" if $mesg->code;
    };
    return $@;
}


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

Add the given list.

=cut

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

    $l->{description} = explode ($options{'-concat'}, $l->{description})
        if defined $l->{description};


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

        my %attrs = ( objectClass => 'FripostVirtualList'
                    , fripostIsStatusActive => $l->{isactive} ? 'TRUE' : 'FALSE'
                    , fripostOwner => $self->whoami
                    , fripostListManager => $l->{transport}
                    );
        if ($l->{transport} eq 'mailman') {
            $attrs{fripostListCommand} =
                [ map { $l2.'-'.$_ }
                      qw/admin bounces confirm join leave loop owner
                         request subscribe unsubscribe/ ];
        }
        elsif ($l->{transport} eq 'schleuder') {
            $attrs{fripostListCommand} =
                [ map { $l2.'-'.$_ }
                      # TODO: check that
                      qw/request bounce sendkey owner/ ];
        }
        $attrs{description} = $l->{description}
            if defined $l->{description} and @{$l->{description}};

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


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

Delete the given list. Note: this will NOT wipe the archives off the
disk, but merely delete the list 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( "fvl=$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;
    }
}


=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 $l = shift;
    must_attrs( $l, qw/list isactive/ );
    $l->{list} = email_valid( $l->{list}, -exact => 1 );

    die "Invalid transport: ‘".$l->{transport}."‘\n"
        if defined $l->{transport} and
            $l->{transport} !~ /^(schleuder|mailman)$/;
    # TODO: check commands
}


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