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 (I, I) 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 (I, I) 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 (I, I) 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<< >> =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__