From e6789ccf70a5d03a6533d626612e7a88686df0ae Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem.moulin@fripost.org>
Date: Sat, 26 Jan 2013 17:44:34 +0100
Subject: Added -count and -dry-run options.

---
 lib/Fripost/Schema/Domain.pm | 38 +++++++++++++++++++++++++++++---------
 lib/Fripost/Schema/Util.pm   | 32 +++++++++++++-------------------
 2 files changed, 42 insertions(+), 28 deletions(-)

diff --git a/lib/Fripost/Schema/Domain.pm b/lib/Fripost/Schema/Domain.pm
index e8da9a5..ce7b900 100644
--- a/lib/Fripost/Schema/Domain.pm
+++ b/lib/Fripost/Schema/Domain.pm
@@ -154,10 +154,10 @@ current user to read or even search anything, though. The default is to
 retrieve every visible attribute, unless in void context where B<-keys>
 is set to [] that is, no attribute is sent back to the client.
 
-=item B<-assert-exists>
+=item B<-count>
 
-A custom error to be raised on empty result sets. When 0, it makes the
-method returns the size of the result set.
+Returns the number of entries in the result set. The B<-keys> option is
+bypassed not to ask any attribute from the server.
 
 =item B<-sort> => 0|1
 
@@ -212,9 +212,7 @@ sub search {
                                      );
     ldap_error($domains, %options) // return;
 
-    softdie ($options{'-assert-exists'}, %options) // return
-        unless $domains->count;
-    return $domains->count if exists $options{'-assert-exists'};
+    return $domains->count if $options{'-count'};
 
     &_entries_to_domains( $self->whoami, $options{'-keys'} // [],
         wantarray ? ( $options{'-sort'} ? $domains->sorted('fvd')
@@ -500,9 +498,9 @@ sub add {
     my $dn = $self->mail2dn( $domain->{name} );
 
     # Search for an existing domain with the same name.
-    my $exists = $self->search($domain->{name}, %options, '-assert-exists' => 0);
+    my $count = $self->search($domain->{name}, %options, '-count' => 1);
     softdie ( "Domain ‘".$domainname."’ already exists.", %options ) // return
-        if not $options{'-append'} and $exists;
+        if not $options{'-append'} and $count;
     # Stop here in dry-run mode.
     return 1 if $options{'-dry-run'};
 
@@ -511,7 +509,7 @@ sub add {
     Fripost::Schema::Util::clean_ldap_entry( \%attrs );
 
     my ($mesg, $token);
-    if ($options{'-append'} and $exists) {
+    if ($options{'-append'} and $count) {
         # Replace single valued attributes; Add other attributes.
         my %unique = ( fripostIsStatusActive => $attrs{fripostIsStatusActive} );
         delete $attrs{$_} for (keys %unique);
@@ -607,6 +605,16 @@ sub _domain_to_entry {
 
 Unlock the pending I<domainname>, locked with I<token>.
 
+The following options are considered:
+
+=over 4
+
+=item B<-dry-run> => 0|1
+
+Merely simulate the unlock. I<token> is still checked to be a valid code.
+
+=back
+
 Errors can be caught with options B<-die> and B<-error>, see
 B<Fripost::Schema::Util> for details.
 
@@ -631,6 +639,7 @@ sub unlock {
                     "Wrong unlock code for ‘".$domainname."’"
                 };
     ldap_error($mesg, %options, -die => $catch) // return;
+    return 1 if $options{'-dry-run'};
 
     $mesg = $self->ldap->modify( $dn,
                 delete => { 'objectClass' => 'FripostPendingEntry'
@@ -648,6 +657,15 @@ sub unlock {
 
 Replace an existing domain with the given one.
 
+=over 4
+
+=item B<-dry-run> => 0|1
+
+Merely simulate the replacement. I<domain> is still checked to be a
+valid domain in the above representation.
+
+=back
+
 Errors can be caught with options B<-die> and B<-error>, see
 B<Fripost::Schema::Util> for details.
 
@@ -662,6 +680,8 @@ sub replace {
     return if $options{'-error'} && ${$options{'-error'}};
 
     &_is_valid($domain, %options);
+    return 1 if $options{'-dry-run'};
+
     my %entry = $self->_domain_to_entry (%$domain);
     my $mesg = $self->ldap->modify( $self->mail2dn($domain->{name})
                                   , replace => \%entry );
diff --git a/lib/Fripost/Schema/Util.pm b/lib/Fripost/Schema/Util.pm
index 2c71411..32f0237 100644
--- a/lib/Fripost/Schema/Util.pm
+++ b/lib/Fripost/Schema/Util.pm
@@ -185,38 +185,32 @@ sub ldap_error {
         $error = $mesg->error if $mesg->code;
     }
 
-    return 1 unless $error;
-
-    if (defined $options{'-error'}) {
-        ${$options{'-error'}} = $error;
-    }
-    else {
-        die $error, "\n";
-    }
+    &softdie( $error, %options );
 }
 
-sub assert {
-    my $what = shift;
+sub softdie {
+    my $mesg = shift;
     my %options = @_;
 
-    return $what if defined $what;
-    die "Not defined.\n" unless defined $options{'-die'};
+    return 1 unless $mesg;
 
     if (defined $options{'-error'}) {
-        ${$options{'-error'}} = $options{'-die'};
+        ${$options{'-error'}} = $mesg;
+    }
+    elsif (exists $options{'-error'}) {
+        return; # Ignore the error
     }
     else {
-        die $options{'-die'}, "\n";
+        die $mesg, "\n";
     }
 }
 
-sub softdie {
-    my $mesg = shift;
+sub assert {
+    my $what = shift;
     my %options = @_;
 
-    return 1 unless $mesg;
-    $options{'-die'} = $mesg;
-    &assert (undef, %options);
+    return $what if $what;
+    &softdie($options{'-die'} // "Not defined.", %options);
 }
 
 sub dn2mail {
-- 
cgit v1.2.3