1 files changed, 192 insertions, 0 deletions
diff --git a/lib/Fripost/Schema/List.pm b/lib/Fripost/Schema/List.pm
new file mode 100644
index 0000000..f3ce4b8
--- /dev/null
+++ b/lib/Fripost/Schema/List.pm
@@ -0,0 +1,192 @@
+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/;
+
+
+=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 = 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 => $_->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};
+
+    my ($l2,$d) = split /\@/, $l->{list}, 2;
+
+    eval {
+        &_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};
+
+    my ($l2,$d) = split /\@/, $l->{list}, 2;
+
+    eval {
+        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($l2,$d,%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 $@;
+}
+
+
+
+=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/ );
+    email_valid( $l->{list}, -exact => 1 );
+
+    say STDERR $l->{transport};
+
+    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__