1 files changed, 183 insertions, 0 deletions
diff --git a/lib/Fripost/Schema/Domain.pm b/lib/Fripost/Schema/Domain.pm
new file mode 100644
index 0000000..3ff2c25
--- /dev/null
+++ b/lib/Fripost/Schema/Domain.pm
@@ -0,0 +1,183 @@
+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__