aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem.moulin@fripost.org>2013-01-26 17:44:34 +0100
committerGuilhem Moulin <guilhem.moulin@fripost.org>2013-01-26 17:44:34 +0100
commite6789ccf70a5d03a6533d626612e7a88686df0ae (patch)
tree2ec82bc3c8cf2eac02cb38bd7433de2feee1ffce
parenta1f02c6dd593f9e31127025e30d551df4b4cfc83 (diff)
Added -count and -dry-run options.
-rw-r--r--lib/Fripost/Schema/Domain.pm38
-rw-r--r--lib/Fripost/Schema/Util.pm32
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 {