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