@@ -1,5 +1,9 @@
Revision history for Test-Net-LDAP
+0.03 2014-07-19
+ Support array ref as the hostnames for Net::LDAP->new()
+ https://rt.cpan.org/Ticket/Display.html?id=96932
+
0.02 2013-07-07
Add support for root_dse
@@ -4,7 +4,7 @@
"Mahiro Ando <mahiro@cpan.org>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921",
+ "generated_by" : "ExtUtils::MakeMaker version 6.76, CPAN::Meta::Converter version 2.132620",
"license" : [
"perl_5"
],
@@ -38,5 +38,5 @@
}
},
"release_status" : "stable",
- "version" : "0.02"
+ "version" : "0.03"
}
@@ -7,7 +7,7 @@ build_requires:
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921'
+generated_by: 'ExtUtils::MakeMaker version 6.76, CPAN::Meta::Converter version 2.132620'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -20,4 +20,4 @@ no_index:
requires:
Net::LDAP: 0.52
Test::More: 0
-version: 0.02
+version: 0.03
@@ -10,65 +10,65 @@ use Test::Builder;
use Test::Net::LDAP::Util;
for my $method (qw(search compare add modify delete moddn bind unbind abandon)) {
- no strict 'refs';
-
- *{__PACKAGE__.'::'.$method.'_ok'} = sub {
- my $self = shift;
- local $Test::Builder::Level = $Test::Builder::Level + 1;
- return $self->method_ok($method, @_);
- };
-
- *{__PACKAGE__.'::'.$method.'_is'} = sub {
- my $self = shift;
- local $Test::Builder::Level = $Test::Builder::Level + 1;
- return $self->method_is($method, @_);
- };
+ no strict 'refs';
+
+ *{__PACKAGE__.'::'.$method.'_ok'} = sub {
+ my $self = shift;
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ return $self->method_ok($method, @_);
+ };
+
+ *{__PACKAGE__.'::'.$method.'_is'} = sub {
+ my $self = shift;
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ return $self->method_is($method, @_);
+ };
}
sub method_ok {
- my $ldap = shift;
- my $method = shift;
- my ($params, $name);
-
- if (ref $_[0] eq 'ARRAY') {
- ($params, $name) = @_;
- } else {
- $params = \@_;
- }
-
- my $expected = Net::LDAP::Constant::LDAP_SUCCESS;
- return $ldap->method_is($method, $params, $expected, $name);
+ my $ldap = shift;
+ my $method = shift;
+ my ($params, $name);
+
+ if (ref $_[0] eq 'ARRAY') {
+ ($params, $name) = @_;
+ } else {
+ $params = \@_;
+ }
+
+ my $expected = Net::LDAP::Constant::LDAP_SUCCESS;
+ return $ldap->method_is($method, $params, $expected, $name);
}
sub method_is {
- my $ldap = shift;
- my $method = shift;
- my ($params, $expected, $name);
-
- if (ref $_[0] eq 'ARRAY') {
- ($params, $expected, $name) = @_;
- } else {
- $params = \@_;
- }
-
- my $mesg = $ldap->$method(@$params);
-
- unless (defined $name) {
- my $arg = Net::LDAP::_dn_options(@$params);
-
- $name = $method.'('.join(', ', map {
- my ($param, $value) = ($_, "$arg->{$_}");
- $value = substr($value, 0, 32).'...' if length($value) > 32;
- qq($param => "$value");
- } grep {
- defined $arg->{$_}
- } qw(base scope filter dn newrdn newsuperior)).')';
- }
-
- local $Test::Builder::Level = $Test::Builder::Level + 1;
- Test::Net::LDAP::Util::ldap_result_is($mesg, $expected, $name);
-
- return $mesg;
+ my $ldap = shift;
+ my $method = shift;
+ my ($params, $expected, $name);
+
+ if (ref $_[0] eq 'ARRAY') {
+ ($params, $expected, $name) = @_;
+ } else {
+ $params = \@_;
+ }
+
+ my $mesg = $ldap->$method(@$params);
+
+ unless (defined $name) {
+ my $arg = Net::LDAP::_dn_options(@$params);
+
+ $name = $method.'('.join(', ', map {
+ my ($param, $value) = ($_, "$arg->{$_}");
+ $value = substr($value, 0, 32).'...' if length($value) > 32;
+ qq($param => "$value");
+ } grep {
+ defined $arg->{$_}
+ } qw(base scope filter dn newrdn newsuperior)).')';
+ }
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ Test::Net::LDAP::Util::ldap_result_is($mesg, $expected, $name);
+
+ return $mesg;
}
1;
@@ -7,16 +7,16 @@ use base qw(Test::Net::LDAP::Mixin);
use Net::LDAP;
use Net::LDAP::Constant qw(
- LDAP_SUCCESS
- LDAP_COMPARE_TRUE LDAP_COMPARE_FALSE
- LDAP_NO_SUCH_OBJECT LDAP_ALREADY_EXISTS
- LDAP_INVALID_DN_SYNTAX LDAP_PARAM_ERROR
+ LDAP_SUCCESS
+ LDAP_COMPARE_TRUE LDAP_COMPARE_FALSE
+ LDAP_NO_SUCH_OBJECT LDAP_ALREADY_EXISTS
+ LDAP_INVALID_DN_SYNTAX LDAP_PARAM_ERROR
);
use Net::LDAP::Entry;
use Net::LDAP::Filter;
use Net::LDAP::FilterMatch;
use Net::LDAP::Util qw(
- canonical_dn escape_dn_value ldap_explode_dn
+ canonical_dn escape_dn_value ldap_explode_dn
);
use Scalar::Util qw(blessed);
use Test::Net::LDAP::Util;
@@ -27,532 +27,532 @@ my %deref = qw(never 0 search 1 find 2 always 3);
%deref = (%deref, map {$_ => $_} values %deref);
sub new {
- my ($class, $ldap) = @_;
- require Test::Net::LDAP::Mock::Node;
-
- my $self = bless {
- root => Test::Net::LDAP::Mock::Node->new,
- ldap => $ldap,
- schema => undef,
- }, $class;
-
- $self->{ldap} ||= do {
- require Test::Net::LDAP::Mock;
- my $ldap = Test::Net::LDAP::Mock->new;
- $ldap->{mock_data} = $self;
- $ldap;
- };
-
- return $self;
+ my ($class, $ldap) = @_;
+ require Test::Net::LDAP::Mock::Node;
+
+ my $self = bless {
+ root => Test::Net::LDAP::Mock::Node->new,
+ ldap => $ldap,
+ schema => undef,
+ }, $class;
+
+ $self->{ldap} ||= do {
+ require Test::Net::LDAP::Mock;
+ my $ldap = Test::Net::LDAP::Mock->new;
+ $ldap->{mock_data} = $self;
+ $ldap;
+ };
+
+ return $self;
}
sub root {
- shift->{root};
+ shift->{root};
}
sub schema {
- my $self = shift;
-
- if (@_) {
- my $schema = $self->{schema};
- $self->{schema} = $_[0];
- return $schema;
- } else {
- return $self->{schema};
- }
+ my $self = shift;
+
+ if (@_) {
+ my $schema = $self->{schema};
+ $self->{schema} = $_[0];
+ return $schema;
+ } else {
+ return $self->{schema};
+ }
}
sub ldap {
- my $self = shift;
-
- if (@_) {
- my $ldap = $self->{ldap};
- $self->{ldap} = $_[0];
- return $ldap;
- } else {
- return $self->{ldap};
- }
+ my $self = shift;
+
+ if (@_) {
+ my $ldap = $self->{ldap};
+ $self->{ldap} = $_[0];
+ return $ldap;
+ } else {
+ return $self->{ldap};
+ }
}
sub root_dse {
- my $self = shift;
- $self->ldap->root_dse(@_);
+ my $self = shift;
+ $self->ldap->root_dse(@_);
}
sub mock_root_dse {
- my $self = shift;
- my $root_node = $self->root;
-
- if (@_) {
- require Net::LDAP::RootDSE;
- my $old_entry = $root_node->entry;
- my $new_entry;
-
- if ($_[0] && blessed($_[0]) && $_[0]->isa('Net::LDAP::Entry')) {
- $new_entry = $_[0]->clone;
- $new_entry->dn('');
-
- unless ($new_entry->isa('Net::LDAP::RootDSE')) {
- bless $new_entry, 'Net::LDAP::RootDSE';
- }
- } else {
- $new_entry = Net::LDAP::RootDSE->new('', @_);
- }
-
- unless ($new_entry->get_value('objectClass')) {
- $new_entry->add(objectClass => 'top');
- # Net::LDAP::root_dse uses the filter '(objectclass=*)' to search
- # for the root DSE.
- }
-
- $root_node->entry($new_entry);
- return $old_entry;
- } else {
- return $root_node->entry;
- }
+ my $self = shift;
+ my $root_node = $self->root;
+
+ if (@_) {
+ require Net::LDAP::RootDSE;
+ my $old_entry = $root_node->entry;
+ my $new_entry;
+
+ if ($_[0] && blessed($_[0]) && $_[0]->isa('Net::LDAP::Entry')) {
+ $new_entry = $_[0]->clone;
+ $new_entry->dn('');
+
+ unless ($new_entry->isa('Net::LDAP::RootDSE')) {
+ bless $new_entry, 'Net::LDAP::RootDSE';
+ }
+ } else {
+ $new_entry = Net::LDAP::RootDSE->new('', @_);
+ }
+
+ unless ($new_entry->get_value('objectClass')) {
+ $new_entry->add(objectClass => 'top');
+ # Net::LDAP::root_dse uses the filter '(objectclass=*)' to search
+ # for the root DSE.
+ }
+
+ $root_node->entry($new_entry);
+ return $old_entry;
+ } else {
+ return $root_node->entry;
+ }
}
sub _result_entry {
- my ($self, $input_entry, $arg) = @_;
- my $attrs = $arg->{attrs} || [];
- my $output_entry;
-
- if (@$attrs) {
- $output_entry = Net::LDAP::Entry->new;
- $output_entry->dn($input_entry->dn);
-
- $output_entry->add(
- map {$_ => [$input_entry->get_value($_)]} @$attrs
- );
- } else {
- $output_entry = $input_entry->clone;
- }
-
- $output_entry->changetype('modify');
- return $output_entry;
+ my ($self, $input_entry, $arg) = @_;
+ my $attrs = $arg->{attrs} || [];
+ my $output_entry;
+
+ if (@$attrs) {
+ $output_entry = Net::LDAP::Entry->new;
+ $output_entry->dn($input_entry->dn);
+
+ $output_entry->add(
+ map {$_ => [$input_entry->get_value($_)]} @$attrs
+ );
+ } else {
+ $output_entry = $input_entry->clone;
+ }
+
+ $output_entry->changetype('modify');
+ return $output_entry;
}
sub _error {
- my $self = shift;
- $self->ldap->_error(@_);
+ my $self = shift;
+ $self->ldap->_error(@_);
}
sub _mock_message {
- my $self = shift;
- $self->ldap->_mock_message(@_);
+ my $self = shift;
+ $self->ldap->_mock_message(@_);
}
sub bind {
- my $self = shift;
- my $arg = &Net::LDAP::_dn_options;
- require Net::LDAP::Bind;
- my $mesg = $self->_mock_message('Net::LDAP::Bind' => $arg);
-
- if (my $callback = $arg->{callback}) {
- $callback->($mesg);
- }
-
- return $mesg;
+ my $self = shift;
+ my $arg = &Net::LDAP::_dn_options;
+ require Net::LDAP::Bind;
+ my $mesg = $self->_mock_message('Net::LDAP::Bind' => $arg);
+
+ if (my $callback = $arg->{callback}) {
+ $callback->($mesg);
+ }
+
+ return $mesg;
}
sub unbind {
- my $self = shift;
- my $arg = &Net::LDAP::_dn_options;
- my $mesg = $self->_mock_message('Net::LDAP::Unbind' => $arg);
-
- if (my $callback = $arg->{callback}) {
- $callback->($mesg);
- }
-
- return $mesg;
+ my $self = shift;
+ my $arg = &Net::LDAP::_dn_options;
+ my $mesg = $self->_mock_message('Net::LDAP::Unbind' => $arg);
+
+ if (my $callback = $arg->{callback}) {
+ $callback->($mesg);
+ }
+
+ return $mesg;
}
sub abandon {
- my $self = shift;
- my $arg = &Net::LDAP::_dn_options;
- my $mesg = $self->_mock_message('Net::LDAP::Abandon' => $arg);
-
- if (my $callback = $arg->{callback}) {
- $callback->($mesg);
- }
-
- return $mesg;
+ my $self = shift;
+ my $arg = &Net::LDAP::_dn_options;
+ my $mesg = $self->_mock_message('Net::LDAP::Abandon' => $arg);
+
+ if (my $callback = $arg->{callback}) {
+ $callback->($mesg);
+ }
+
+ return $mesg;
}
sub search {
- my $self = shift;
- my $arg = &Net::LDAP::_dn_options;
-
- require Net::LDAP::Search;
- my $mesg = $self->_mock_message('Net::LDAP::Search' => $arg);
-
- # Configure params
- my $base = $arg->{base} || '';
- $base = ldap_explode_dn($base, casefold => 'lower');
-
- unless ($base) {
- return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN');
- }
-
- my $filter = $arg->{filter};
-
- if (defined $filter && !ref($filter) && $filter ne '') {
- my $f = Net::LDAP::Filter->new;
-
- unless ($f->parse($filter)) {
- return $self->_error($mesg, LDAP_PARAM_ERROR, 'Bad filter');
- }
-
- $filter = $f;
- } else {
- $filter = undef;
- }
-
- my $scope = $scope{$arg->{scope} || 0};
-
- unless (defined $scope) {
- return $self->_error($mesg, LDAP_PARAM_ERROR, 'invalid scope');
- }
-
- my $callback = $arg->{callback};
-
- # Traverse tree
- $mesg->{entries} = [];
- my $base_node = $base ? $self->root->get_node($base) : $self->root;
-
- unless ($base_node) {
- return $self->_error($mesg, LDAP_NO_SUCH_OBJECT, '');
- }
-
- $callback->($mesg) if $callback;
-
- $base_node->traverse(sub {
- my ($node) = @_;
- my $entry = $node->entry;
- my $schema = $self->schema;
-
- if ($entry && (!$filter || $filter->match($entry, $schema))) {
- my $result_entry = $self->_result_entry($entry, $arg);
- push @{$mesg->{entries}}, $result_entry;
- $callback->($mesg, $result_entry) if $callback;
- }
- }, $scope);
-
- return $mesg;
+ my $self = shift;
+ my $arg = &Net::LDAP::_dn_options;
+
+ require Net::LDAP::Search;
+ my $mesg = $self->_mock_message('Net::LDAP::Search' => $arg);
+
+ # Configure params
+ my $base = $arg->{base} || '';
+ $base = ldap_explode_dn($base, casefold => 'lower');
+
+ unless ($base) {
+ return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN');
+ }
+
+ my $filter = $arg->{filter};
+
+ if (defined $filter && !ref($filter) && $filter ne '') {
+ my $f = Net::LDAP::Filter->new;
+
+ unless ($f->parse($filter)) {
+ return $self->_error($mesg, LDAP_PARAM_ERROR, 'Bad filter');
+ }
+
+ $filter = $f;
+ } else {
+ $filter = undef;
+ }
+
+ my $scope = $scope{$arg->{scope} || 0};
+
+ unless (defined $scope) {
+ return $self->_error($mesg, LDAP_PARAM_ERROR, 'invalid scope');
+ }
+
+ my $callback = $arg->{callback};
+
+ # Traverse tree
+ $mesg->{entries} = [];
+ my $base_node = $base ? $self->root->get_node($base) : $self->root;
+
+ unless ($base_node) {
+ return $self->_error($mesg, LDAP_NO_SUCH_OBJECT, '');
+ }
+
+ $callback->($mesg) if $callback;
+
+ $base_node->traverse(sub {
+ my ($node) = @_;
+ my $entry = $node->entry;
+ my $schema = $self->schema;
+
+ if ($entry && (!$filter || $filter->match($entry, $schema))) {
+ my $result_entry = $self->_result_entry($entry, $arg);
+ push @{$mesg->{entries}}, $result_entry;
+ $callback->($mesg, $result_entry) if $callback;
+ }
+ }, $scope);
+
+ return $mesg;
}
sub compare {
- my $self = shift;
- my $arg = &Net::LDAP::_dn_options;
- my $mesg = $self->_mock_message('Net::LDAP::Compare' => $arg);
-
- my $dn = (ref $arg->{dn} ? $arg->{dn}->dn : $arg->{dn});
-
- unless ($dn) {
- return $self->_error($mesg, LDAP_PARAM_ERROR, 'No DN specified');
- }
-
- my $dn_list = ldap_explode_dn($dn, casefold => 'lower');
-
- unless ($dn_list) {
- return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN');
- }
-
- my $attr = exists $arg->{attr}
- ? $arg->{attr}
- : exists $arg->{attrs} #compat
- ? $arg->{attrs}[0]
- : "";
+ my $self = shift;
+ my $arg = &Net::LDAP::_dn_options;
+ my $mesg = $self->_mock_message('Net::LDAP::Compare' => $arg);
+
+ my $dn = (ref $arg->{dn} ? $arg->{dn}->dn : $arg->{dn});
+
+ unless ($dn) {
+ return $self->_error($mesg, LDAP_PARAM_ERROR, 'No DN specified');
+ }
+
+ my $dn_list = ldap_explode_dn($dn, casefold => 'lower');
+
+ unless ($dn_list) {
+ return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN');
+ }
+
+ my $attr = exists $arg->{attr}
+ ? $arg->{attr}
+ : exists $arg->{attrs} #compat
+ ? $arg->{attrs}[0]
+ : "";
- my $value = exists $arg->{value}
- ? $arg->{value}
- : exists $arg->{attrs} #compat
- ? $arg->{attrs}[1]
- : "";
-
- my $node = $self->root->get_node($dn_list);
-
- unless ($node && $node->entry) {
- return $self->_error($mesg, LDAP_NO_SUCH_OBJECT, '');
- }
-
- my $entry = $node->entry;
-
- my $filter = bless {
- equalityMatch => {
- attributeDesc => $attr,
- assertionValue => $value,
- }
- }, 'Net::LDAP::Filter';
-
- $mesg->{resultCode} = $filter->match($entry, $self->schema)
- ? LDAP_COMPARE_TRUE : LDAP_COMPARE_FALSE;
-
- if (my $callback = $arg->{callback}) {
- $callback->($mesg);
- }
-
- return $mesg;
+ my $value = exists $arg->{value}
+ ? $arg->{value}
+ : exists $arg->{attrs} #compat
+ ? $arg->{attrs}[1]
+ : "";
+
+ my $node = $self->root->get_node($dn_list);
+
+ unless ($node && $node->entry) {
+ return $self->_error($mesg, LDAP_NO_SUCH_OBJECT, '');
+ }
+
+ my $entry = $node->entry;
+
+ my $filter = bless {
+ equalityMatch => {
+ attributeDesc => $attr,
+ assertionValue => $value,
+ }
+ }, 'Net::LDAP::Filter';
+
+ $mesg->{resultCode} = $filter->match($entry, $self->schema)
+ ? LDAP_COMPARE_TRUE : LDAP_COMPARE_FALSE;
+
+ if (my $callback = $arg->{callback}) {
+ $callback->($mesg);
+ }
+
+ return $mesg;
}
sub add {
- my $self = shift;
- my $arg = &Net::LDAP::_dn_options;
- my $mesg = $self->_mock_message('Net::LDAP::Add' => $arg);
-
- my $dn = ref $arg->{dn} ? $arg->{dn}->dn : $arg->{dn};
-
- unless ($dn) {
- return $self->_error($mesg, LDAP_PARAM_ERROR, 'No DN specified');
- }
-
- my $dn_list = ldap_explode_dn($dn, casefold => 'lower');
-
- unless ($dn_list) {
- return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN');
- }
-
- my $node = $self->root->make_node($dn);
-
- if ($node->entry) {
- return $self->_error($mesg, LDAP_ALREADY_EXISTS, '');
- }
-
- my $entry;
-
- if (ref $arg->{dn}) {
- $entry = $arg->{dn}->clone;
- } else {
- $entry = Net::LDAP::Entry->new(
- $arg->{dn},
- @{$arg->{attrs} || $arg->{attr} || []}
- );
- }
-
- $entry->dn(canonical_dn($dn_list, casefold => 'lower'));
-
- if (my $rdn = $dn_list->[0]) {
- $entry->delete(%$rdn);
- $entry->add(%$rdn);
- }
-
- $entry->changetype('add');
- $node->entry($entry);
-
- if (my $callback = $arg->{callback}) {
- $callback->($mesg);
- }
-
- return $mesg;
+ my $self = shift;
+ my $arg = &Net::LDAP::_dn_options;
+ my $mesg = $self->_mock_message('Net::LDAP::Add' => $arg);
+
+ my $dn = ref $arg->{dn} ? $arg->{dn}->dn : $arg->{dn};
+
+ unless ($dn) {
+ return $self->_error($mesg, LDAP_PARAM_ERROR, 'No DN specified');
+ }
+
+ my $dn_list = ldap_explode_dn($dn, casefold => 'lower');
+
+ unless ($dn_list) {
+ return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN');
+ }
+
+ my $node = $self->root->make_node($dn);
+
+ if ($node->entry) {
+ return $self->_error($mesg, LDAP_ALREADY_EXISTS, '');
+ }
+
+ my $entry;
+
+ if (ref $arg->{dn}) {
+ $entry = $arg->{dn}->clone;
+ } else {
+ $entry = Net::LDAP::Entry->new(
+ $arg->{dn},
+ @{$arg->{attrs} || $arg->{attr} || []}
+ );
+ }
+
+ $entry->dn(canonical_dn($dn_list, casefold => 'lower'));
+
+ if (my $rdn = $dn_list->[0]) {
+ $entry->delete(%$rdn);
+ $entry->add(%$rdn);
+ }
+
+ $entry->changetype('add');
+ $node->entry($entry);
+
+ if (my $callback = $arg->{callback}) {
+ $callback->($mesg);
+ }
+
+ return $mesg;
}
my %opcode = (add => 0, delete => 1, replace => 2, increment => 3);
sub modify {
- my $self = shift;
- my $arg = &Net::LDAP::_dn_options;
- my $mesg = $self->_mock_message('Net::LDAP::Modify' => $arg);
-
- my $dn = (ref $arg->{dn} ? $arg->{dn}->dn : $arg->{dn});
-
- unless ($dn) {
- return $self->_error($mesg, LDAP_PARAM_ERROR, 'No DN specified');
- }
-
- my $dn_list = ldap_explode_dn($dn, casefold => 'lower');
-
- unless ($dn_list) {
- return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN');
- }
-
- my $node = $self->root->get_node($dn_list);
-
- unless ($node && $node->entry) {
- return $self->_error($mesg, LDAP_NO_SUCH_OBJECT, '');
- }
-
- my $entry = $node->entry;
-
- if (exists $arg->{changes}) {
- for (my $j = 0; $j < @{$arg->{changes}}; $j += 2) {
- my $op = $arg->{changes}[$j];
- my $chg = $arg->{changes}[$j + 1];
-
- unless (defined $opcode{$op}) {
- return $self->_error($mesg, LDAP_PARAM_ERROR, "Bad change type '$op'");
- }
-
- $entry->$op(@$chg);
- }
- } else {
- for my $op (keys %opcode) {
- my $chg = $arg->{$op} or next;
- my $opcode = $opcode{$op};
- my $ref_chg = ref $chg;
-
- if ($opcode == 3) {
- # $op eq 'increment'
- if ($ref_chg eq 'HASH') {
- for my $attr (keys %$chg) {
- my $incr = $chg->{$attr};
-
- $entry->replace(
- $attr => [map {$_ + $incr} $entry->get_value($attr)]
- );
- }
- } elsif ($ref_chg eq 'ARRAY') {
- for (my $i = 0; $i < @$chg; $i += 2) {
- my ($attr, $incr) = ($chg->[$i], $chg->[$i + 1]);
- next unless defined $incr;
-
- $entry->replace(
- $attr => [map {$_ + $incr} $entry->get_value($attr)]
- );
- }
- } elsif (!$ref_chg) {
- $entry->replace(
- $chg => [map {$_ + 1} $entry->get_value($chg)]
- );
- }
- } elsif ($ref_chg eq 'HASH') {
- $entry->$op(%$chg);
- } elsif ($ref_chg eq 'ARRAY') {
- if ($opcode == 1) {
- # $op eq 'delete'
- $entry->$op(map {$_ => []} @$chg);
- } else {
- $entry->$op(@$chg);
- }
- } elsif (!$ref_chg) {
- $entry->$op($chg => []);
- }
- }
- }
-
- if (my $callback = $arg->{callback}) {
- $callback->($mesg);
- }
-
- return $mesg;
+ my $self = shift;
+ my $arg = &Net::LDAP::_dn_options;
+ my $mesg = $self->_mock_message('Net::LDAP::Modify' => $arg);
+
+ my $dn = (ref $arg->{dn} ? $arg->{dn}->dn : $arg->{dn});
+
+ unless ($dn) {
+ return $self->_error($mesg, LDAP_PARAM_ERROR, 'No DN specified');
+ }
+
+ my $dn_list = ldap_explode_dn($dn, casefold => 'lower');
+
+ unless ($dn_list) {
+ return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN');
+ }
+
+ my $node = $self->root->get_node($dn_list);
+
+ unless ($node && $node->entry) {
+ return $self->_error($mesg, LDAP_NO_SUCH_OBJECT, '');
+ }
+
+ my $entry = $node->entry;
+
+ if (exists $arg->{changes}) {
+ for (my $j = 0; $j < @{$arg->{changes}}; $j += 2) {
+ my $op = $arg->{changes}[$j];
+ my $chg = $arg->{changes}[$j + 1];
+
+ unless (defined $opcode{$op}) {
+ return $self->_error($mesg, LDAP_PARAM_ERROR, "Bad change type '$op'");
+ }
+
+ $entry->$op(@$chg);
+ }
+ } else {
+ for my $op (keys %opcode) {
+ my $chg = $arg->{$op} or next;
+ my $opcode = $opcode{$op};
+ my $ref_chg = ref $chg;
+
+ if ($opcode == 3) {
+ # $op eq 'increment'
+ if ($ref_chg eq 'HASH') {
+ for my $attr (keys %$chg) {
+ my $incr = $chg->{$attr};
+
+ $entry->replace(
+ $attr => [map {$_ + $incr} $entry->get_value($attr)]
+ );
+ }
+ } elsif ($ref_chg eq 'ARRAY') {
+ for (my $i = 0; $i < @$chg; $i += 2) {
+ my ($attr, $incr) = ($chg->[$i], $chg->[$i + 1]);
+ next unless defined $incr;
+
+ $entry->replace(
+ $attr => [map {$_ + $incr} $entry->get_value($attr)]
+ );
+ }
+ } elsif (!$ref_chg) {
+ $entry->replace(
+ $chg => [map {$_ + 1} $entry->get_value($chg)]
+ );
+ }
+ } elsif ($ref_chg eq 'HASH') {
+ $entry->$op(%$chg);
+ } elsif ($ref_chg eq 'ARRAY') {
+ if ($opcode == 1) {
+ # $op eq 'delete'
+ $entry->$op(map {$_ => []} @$chg);
+ } else {
+ $entry->$op(@$chg);
+ }
+ } elsif (!$ref_chg) {
+ $entry->$op($chg => []);
+ }
+ }
+ }
+
+ if (my $callback = $arg->{callback}) {
+ $callback->($mesg);
+ }
+
+ return $mesg;
}
sub delete {
- my $self = shift;
- my $arg = &Net::LDAP::_dn_options;
- my $mesg = $self->_mock_message('Net::LDAP::Delete' => $arg);
-
- my $dn = (ref $arg->{dn} ? $arg->{dn}->dn : $arg->{dn});
-
- unless ($dn) {
- return $self->_error($mesg, LDAP_PARAM_ERROR, 'No DN specified');
- }
-
- my $dn_list = ldap_explode_dn($dn, casefold => 'lower');
-
- unless ($dn_list) {
- return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN');
- }
-
- my $node = $self->root->get_node($dn_list);
-
- unless ($node && $node->entry) {
- return $self->_error($mesg, LDAP_NO_SUCH_OBJECT, '');
- }
-
- $node->entry(undef);
-
- if (my $callback = $arg->{callback}) {
- $callback->($mesg);
- }
-
- return $mesg;
+ my $self = shift;
+ my $arg = &Net::LDAP::_dn_options;
+ my $mesg = $self->_mock_message('Net::LDAP::Delete' => $arg);
+
+ my $dn = (ref $arg->{dn} ? $arg->{dn}->dn : $arg->{dn});
+
+ unless ($dn) {
+ return $self->_error($mesg, LDAP_PARAM_ERROR, 'No DN specified');
+ }
+
+ my $dn_list = ldap_explode_dn($dn, casefold => 'lower');
+
+ unless ($dn_list) {
+ return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN');
+ }
+
+ my $node = $self->root->get_node($dn_list);
+
+ unless ($node && $node->entry) {
+ return $self->_error($mesg, LDAP_NO_SUCH_OBJECT, '');
+ }
+
+ $node->entry(undef);
+
+ if (my $callback = $arg->{callback}) {
+ $callback->($mesg);
+ }
+
+ return $mesg;
}
sub moddn {
- my $self = shift;
- my $arg = &Net::LDAP::_dn_options;
- my $mesg = $self->_mock_message('Net::LDAP::ModDN' => $arg);
-
- my $dn = (ref $arg->{dn} ? $arg->{dn}->dn : $arg->{dn});
-
- unless ($dn) {
- return $self->_error($mesg, LDAP_PARAM_ERROR, 'No DN specified');
- }
-
- my $dn_list = ldap_explode_dn($dn, casefold => 'lower');
-
- unless ($dn_list) {
- return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN');
- }
-
- my $old_rdn = $dn_list->[0];
- my $old_node = $self->root->get_node($dn_list);
-
- unless ($old_node && $old_node->entry) {
- return $self->_error($mesg, LDAP_NO_SUCH_OBJECT, '');
- }
-
- # Configure new RDN
- my $new_rdn;
- my $rdn_changed = 0;
-
- if (defined(my $new_rdn_value = $arg->{newrdn})) {
- my $new_rdn_list = ldap_explode_dn($new_rdn_value, casefold => 'lower');
-
- unless ($new_rdn_list) {
- return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid new RDN');
- }
-
- $new_rdn = $new_rdn_list->[0];
- $rdn_changed = 1;
- } else {
- $new_rdn = $dn_list->[0];
- }
-
- # Configure new DN
- if (defined(my $new_superior = $arg->{newsuperior})) {
- $dn_list = ldap_explode_dn($new_superior, casefold => 'lower');
-
- unless ($dn_list) {
- return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid newSuperior');
- }
-
- unshift @$dn_list, $new_rdn;
- } else {
- $dn_list->[0] = $new_rdn;
- }
-
- my $new_dn = canonical_dn($dn_list, casefold => 'lower');
-
- # Create new node
- my $new_node = $self->root->make_node($dn_list);
-
- if ($new_node->entry) {
- return $self->_error($mesg, LDAP_ALREADY_EXISTS, '');
- }
-
- # Set up new entry
- my $new_entry = $old_node->entry;
- $old_node->entry(undef);
-
- $new_entry->dn($new_dn);
-
- if ($rdn_changed) {
- if ($arg->{deleteoldrdn}) {
- $new_entry->delete(%$old_rdn);
- }
-
- $new_entry->delete(%$new_rdn);
- $new_entry->add(%$new_rdn);
- }
-
- $new_node->entry($new_entry);
-
- if (my $callback = $arg->{callback}) {
- $callback->($mesg);
- }
-
- return $mesg;
+ my $self = shift;
+ my $arg = &Net::LDAP::_dn_options;
+ my $mesg = $self->_mock_message('Net::LDAP::ModDN' => $arg);
+
+ my $dn = (ref $arg->{dn} ? $arg->{dn}->dn : $arg->{dn});
+
+ unless ($dn) {
+ return $self->_error($mesg, LDAP_PARAM_ERROR, 'No DN specified');
+ }
+
+ my $dn_list = ldap_explode_dn($dn, casefold => 'lower');
+
+ unless ($dn_list) {
+ return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN');
+ }
+
+ my $old_rdn = $dn_list->[0];
+ my $old_node = $self->root->get_node($dn_list);
+
+ unless ($old_node && $old_node->entry) {
+ return $self->_error($mesg, LDAP_NO_SUCH_OBJECT, '');
+ }
+
+ # Configure new RDN
+ my $new_rdn;
+ my $rdn_changed = 0;
+
+ if (defined(my $new_rdn_value = $arg->{newrdn})) {
+ my $new_rdn_list = ldap_explode_dn($new_rdn_value, casefold => 'lower');
+
+ unless ($new_rdn_list) {
+ return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid new RDN');
+ }
+
+ $new_rdn = $new_rdn_list->[0];
+ $rdn_changed = 1;
+ } else {
+ $new_rdn = $dn_list->[0];
+ }
+
+ # Configure new DN
+ if (defined(my $new_superior = $arg->{newsuperior})) {
+ $dn_list = ldap_explode_dn($new_superior, casefold => 'lower');
+
+ unless ($dn_list) {
+ return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid newSuperior');
+ }
+
+ unshift @$dn_list, $new_rdn;
+ } else {
+ $dn_list->[0] = $new_rdn;
+ }
+
+ my $new_dn = canonical_dn($dn_list, casefold => 'lower');
+
+ # Create new node
+ my $new_node = $self->root->make_node($dn_list);
+
+ if ($new_node->entry) {
+ return $self->_error($mesg, LDAP_ALREADY_EXISTS, '');
+ }
+
+ # Set up new entry
+ my $new_entry = $old_node->entry;
+ $old_node->entry(undef);
+
+ $new_entry->dn($new_dn);
+
+ if ($rdn_changed) {
+ if ($arg->{deleteoldrdn}) {
+ $new_entry->delete(%$old_rdn);
+ }
+
+ $new_entry->delete(%$new_rdn);
+ $new_entry->add(%$new_rdn);
+ }
+
+ $new_node->entry($new_entry);
+
+ if (my $callback = $arg->{callback}) {
+ $callback->($mesg);
+ }
+
+ return $mesg;
}
1;
@@ -8,110 +8,110 @@ use Net::LDAP::Util qw(canonical_dn ldap_explode_dn);
use Scalar::Util qw(blessed);
sub new {
- my ($class) = @_;
- return bless {entry => undef, submap => {}}, $class;
+ my ($class) = @_;
+ return bless {entry => undef, submap => {}}, $class;
}
sub entry {
- my $self = shift;
-
- if (@_) {
- my $old = $self->{entry};
- $self->{entry} = shift;
- return $old;
- } else {
- return $self->{entry};
- }
+ my $self = shift;
+
+ if (@_) {
+ my $old = $self->{entry};
+ $self->{entry} = shift;
+ return $old;
+ } else {
+ return $self->{entry};
+ }
}
sub make_node {
- my ($self, $spec) = @_;
-
- return $self->_descend_path($spec, sub {
- my ($node, $rdn) = @_;
- return $node->_make_subnode($rdn);
- });
+ my ($self, $spec) = @_;
+
+ return $self->_descend_path($spec, sub {
+ my ($node, $rdn) = @_;
+ return $node->_make_subnode($rdn);
+ });
}
sub get_node {
- my ($self, $spec) = @_;
-
- return $self->_descend_path($spec, sub {
- my ($node, $rdn) = @_;
- return $node->_get_subnode($rdn);
- });
+ my ($self, $spec) = @_;
+
+ return $self->_descend_path($spec, sub {
+ my ($node, $rdn) = @_;
+ return $node->_get_subnode($rdn);
+ });
}
sub traverse {
- my ($self, $callback, $scope) = @_;
- $scope ||= 0; # 0: base, 1: one, 2: sub
-
- my $visit;
- $visit = sub {
- my ($node, $deep) = @_;
- $callback->($node);
-
- # $deep == 0 or 1
- if ($scope > $deep) {
- $node->_each_subnode(sub {
- my ($subnode) = @_;
- $visit->($subnode, 1);
- });
- }
- };
-
- $visit->($self, 0);
+ my ($self, $callback, $scope) = @_;
+ $scope ||= 0; # 0: base, 1: one, 2: sub
+
+ my $visit;
+ $visit = sub {
+ my ($node, $deep) = @_;
+ $callback->($node);
+
+ # $deep == 0 or 1
+ if ($scope > $deep) {
+ $node->_each_subnode(sub {
+ my ($subnode) = @_;
+ $visit->($subnode, 1);
+ });
+ }
+ };
+
+ $visit->($self, 0);
}
sub _descend_path {
- my ($self, $spec, $callback) = @_;
-
- if (ref $spec eq 'HASH') {
- my $node = $callback->($self, $spec);
- return $node;
- } else {
- my $dn_list;
-
- if (ref $spec eq 'ARRAY') {
- $dn_list = $spec;
- } else {
- my $dn = blessed($spec) ? $spec->dn : $spec;
- $dn_list = ldap_explode_dn($dn, casefold => 'lower');
- }
-
- my $node = $self;
- my $parent;
-
- for my $rdn (reverse @$dn_list) {
- $parent = $node;
- $node = $callback->($node, $rdn) or last;
- }
-
- return $node;
- }
+ my ($self, $spec, $callback) = @_;
+
+ if (ref $spec eq 'HASH') {
+ my $node = $callback->($self, $spec);
+ return $node;
+ } else {
+ my $dn_list;
+
+ if (ref $spec eq 'ARRAY') {
+ $dn_list = $spec;
+ } else {
+ my $dn = blessed($spec) ? $spec->dn : $spec;
+ $dn_list = ldap_explode_dn($dn, casefold => 'lower');
+ }
+
+ my $node = $self;
+ my $parent;
+
+ for my $rdn (reverse @$dn_list) {
+ $parent = $node;
+ $node = $callback->($node, $rdn) or last;
+ }
+
+ return $node;
+ }
}
sub _make_subnode {
- my ($self, $rdn) = @_;
- # E.g. $rdn == {ou => 'Sales'}
- my $canonical = canonical_dn([$rdn], casefold => 'lower');
- return $self->{submap}{$canonical} ||= ref($self)->new;
+ my ($self, $rdn) = @_;
+ # E.g. $rdn == {ou => 'Sales'}
+ my $canonical = canonical_dn([$rdn], casefold => 'lower');
+ return $self->{submap}{$canonical} ||= ref($self)->new;
}
sub _get_subnode {
- my ($self, $rdn) = @_;
- # E.g. $rdn == {ou => 'Sales'}
- my $canonical = canonical_dn([$rdn], casefold => 'lower');
- return $self->{submap}{$canonical};
+ my ($self, $rdn) = @_;
+ # E.g. $rdn == {ou => 'Sales'}
+ my $canonical = canonical_dn([$rdn], casefold => 'lower');
+ return $self->{submap}{$canonical};
}
sub _each_subnode {
- my ($self, $callback) = @_;
- my $submap = $self->{submap};
-
- for my $canonical (keys %$submap) {
- $callback->($submap->{$canonical});
- }
+ my ($self, $callback) = @_;
+ my $submap = $self->{submap};
+
+ for my $canonical (keys %$submap) {
+ $callback->($submap->{$canonical});
+ }
}
1;
@@ -120,57 +120,64 @@ the target (host/port/path) and scheme (ldap/ldaps/ldapi).
my $mock_map = {};
sub new {
- my $class = shift;
- $class = ref $class || $class;
- $class = __PACKAGE__ if $class eq 'Net::LDAP'; # special case (ldap_mockify)
- my $target = &_mock_target;
-
- my $self = bless {
- mock_data => undef,
- net_ldap_socket => IO::Socket->new(),
- }, $class;
-
- $self->{mock_data} = ($mock_map->{$target} ||= do {
- require Test::Net::LDAP::Mock::Data;
- Test::Net::LDAP::Mock::Data->new($self);
- });
-
- return $self;
+ my $class = shift;
+ $class = ref $class || $class;
+ $class = __PACKAGE__ if $class eq 'Net::LDAP'; # special case (ldap_mockify)
+ my $target = &_mock_target;
+
+ my $self = bless {
+ mock_data => undef,
+ net_ldap_socket => IO::Socket->new(),
+ }, $class;
+
+ $self->{mock_data} = ($mock_map->{$target} ||= do {
+ require Test::Net::LDAP::Mock::Data;
+ Test::Net::LDAP::Mock::Data->new($self);
+ });
+
+ return $self;
}
sub _mock_target {
- my $host = shift if @_ % 2;
- my $arg = &Net::LDAP::_options;
- my $scheme = $arg->{scheme} || 'ldap';
-
- if (length $host) {
- if ($scheme ne 'ldapi' && $host !~ /:\d+$/) {
- $host .= ':'.($arg->{port} || 389);
- }
- } else {
- $host = '';
- }
-
- return "$scheme://$host";
+ my $host = shift if @_ % 2;
+ my $arg = &Net::LDAP::_options;
+ my $scheme = $arg->{scheme} || 'ldap';
+
+ # Net::LDAP->new() can take an array ref as hostnames, where
+ # the first host that we can connect to will be used.
+ # For the mock object, let's just pick the first one.
+ if (ref $host) {
+ $host = $host->[0] || '';
+ }
+
+ if (length $host) {
+ if ($scheme ne 'ldapi' && $host !~ /:\d+$/) {
+ $host .= ':'.($arg->{port} || 389);
+ }
+ } else {
+ $host = '';
+ }
+
+ return "$scheme://$host";
}
sub _mock_message {
- my $self = shift;
- my $mesg = $self->message(@_);
- $mesg->{resultCode} = LDAP_SUCCESS;
- $mesg->{errorMessage} = '';
- $mesg->{matchedDN} = '';
- $mesg->{raw} = undef;
- $mesg->{controls} = undef;
- $mesg->{ctrl_hash} = undef;
- return $mesg;
+ my $self = shift;
+ my $mesg = $self->message(@_);
+ $mesg->{resultCode} = LDAP_SUCCESS;
+ $mesg->{errorMessage} = '';
+ $mesg->{matchedDN} = '';
+ $mesg->{raw} = undef;
+ $mesg->{controls} = undef;
+ $mesg->{ctrl_hash} = undef;
+ return $mesg;
}
#override
sub _send_mesg {
- my $ldap = shift;
- my $mesg = shift;
- return $mesg;
+ my $ldap = shift;
+ my $mesg = shift;
+ return $mesg;
}
=head2 mock_data
@@ -180,7 +187,7 @@ Retrieves the currently associated data tree (for the internal purpose only).
=cut
sub mock_data {
- return shift->{mock_data};
+ return shift->{mock_data};
}
=head2 mock_schema
@@ -196,8 +203,8 @@ C<delete>.
=cut
sub mock_schema {
- my $self = shift;
- $self->mock_data->schema(@_);
+ my $self = shift;
+ $self->mock_data->schema(@_);
}
=head2 mock_root_dse
@@ -220,8 +227,8 @@ topmost DN. In other words, even if namingContexts is set to
=cut
sub mock_root_dse {
- my $self = shift;
- $self->mock_data->mock_root_dse(@_);
+ my $self = shift;
+ $self->mock_data->mock_root_dse(@_);
}
=head2 search
@@ -238,8 +245,8 @@ See L<Net::LDAP/search> for more parameter usage.
=cut
sub search {
- my $ldap = shift;
- return $ldap->mock_data->search(@_);
+ my $ldap = shift;
+ return $ldap->mock_data->search(@_);
}
=head2 compare
@@ -257,8 +264,8 @@ See L<Net::LDAP/compare> for more parameter usage.
=cut
sub compare {
- my $ldap = shift;
- return $ldap->mock_data->compare(@_);
+ my $ldap = shift;
+ return $ldap->mock_data->compare(@_);
}
=head2 add
@@ -274,8 +281,8 @@ See L<Net::LDAP/add> for more parameter usage.
=cut
sub add {
- my $ldap = shift;
- return $ldap->mock_data->add(@_);
+ my $ldap = shift;
+ return $ldap->mock_data->add(@_);
}
=head2 modify
@@ -291,8 +298,8 @@ See L<Net::LDAP/modify> for more parameter usage.
=cut
sub modify {
- my $ldap = shift;
- return $ldap->mock_data->modify(@_);
+ my $ldap = shift;
+ return $ldap->mock_data->modify(@_);
}
=head2 delete
@@ -306,8 +313,8 @@ See L<Net::LDAP/delete> for more parameter usage.
=cut
sub delete {
- my $ldap = shift;
- return $ldap->mock_data->delete(@_);
+ my $ldap = shift;
+ return $ldap->mock_data->delete(@_);
}
=head2 moddn
@@ -323,8 +330,8 @@ See L<Net::LDAP/moddn> for more parameter usage.
=cut
sub moddn {
- my $ldap = shift;
- return $ldap->mock_data->moddn(@_);
+ my $ldap = shift;
+ return $ldap->mock_data->moddn(@_);
}
=head2 bind
@@ -334,8 +341,8 @@ Does nothing except for returning a success message.
=cut
sub bind {
- my $ldap = shift;
- return $ldap->mock_data->bind(@_);
+ my $ldap = shift;
+ return $ldap->mock_data->bind(@_);
}
=head2 unbind
@@ -345,8 +352,8 @@ Does nothing except for returning a success message.
=cut
sub unbind {
- my $ldap = shift;
- return $ldap->mock_data->unbind(@_);
+ my $ldap = shift;
+ return $ldap->mock_data->unbind(@_);
}
=head2 abandon
@@ -356,8 +363,8 @@ Does nothing except for returning a success message.
=cut
sub abandon {
- my $ldap = shift;
- return $ldap->mock_data->abandon(@_);
+ my $ldap = shift;
+ return $ldap->mock_data->abandon(@_);
}
1;
@@ -10,9 +10,9 @@ use Net::LDAP::Util qw(ldap_error_name ldap_error_text);
use Test::Builder;
our @EXPORT_OK = qw(
- ldap_result_ok
- ldap_result_is
- ldap_mockify
+ ldap_result_ok
+ ldap_result_is
+ ldap_mockify
);
our %EXPORT_TAGS = (all => \@EXPORT_OK);
@@ -57,9 +57,9 @@ C<$name> is the optional test name.
=cut
sub ldap_result_ok {
- my ($mesg, $name) = @_;
- local $Test::Builder::Level = $Test::Builder::Level + 1;
- return ldap_result_is($mesg, LDAP_SUCCESS, $name);
+ my ($mesg, $name) = @_;
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ return ldap_result_is($mesg, LDAP_SUCCESS, $name);
}
=head2 ldap_result_is
@@ -78,33 +78,33 @@ C<$name> is the optional test name.
my $test_builder;
sub ldap_result_is {
- my ($actual, $expected, $name) = @_;
- $expected = LDAP_SUCCESS unless defined $expected;
-
- $test_builder ||= Test::Builder->new;
-
- my $actual_code = ref $actual ? $actual->code : $actual;
- my $expected_code = ref $expected ? $expected->code : $expected;
- my $success = ($actual_code == $expected_code);
-
- local $Test::Builder::Level = $Test::Builder::Level + 1;
- $test_builder->ok($success, $name);
-
- unless ($success) {
- my $actual_text = ldap_error_name($actual).' ('.$actual_code.'): '.
- ((ref $actual && $actual->error) || ldap_error_text($actual));
-
- my $expected_text = ldap_error_name($expected).' ('.$expected_code.')';
-
- # Indent spaces are based on Test::Builder::_is_diag implementation
- # ($Test::Builder::VERSION == 0.98)
- $test_builder->diag(
- sprintf("%12s: %s\n", 'got', $actual_text).
- sprintf("%12s: %s\n", 'expected', $expected_text)
- );
- }
-
- return $actual;
+ my ($actual, $expected, $name) = @_;
+ $expected = LDAP_SUCCESS unless defined $expected;
+
+ $test_builder ||= Test::Builder->new;
+
+ my $actual_code = ref $actual ? $actual->code : $actual;
+ my $expected_code = ref $expected ? $expected->code : $expected;
+ my $success = ($actual_code == $expected_code);
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ $test_builder->ok($success, $name);
+
+ unless ($success) {
+ my $actual_text = ldap_error_name($actual).' ('.$actual_code.'): '.
+ ((ref $actual && $actual->error) || ldap_error_text($actual));
+
+ my $expected_text = ldap_error_name($expected).' ('.$expected_code.')';
+
+ # Indent spaces are based on Test::Builder::_is_diag implementation
+ # ($Test::Builder::VERSION == 0.98)
+ $test_builder->diag(
+ sprintf("%12s: %s\n", 'got', $actual_text).
+ sprintf("%12s: %s\n", 'expected', $expected_text)
+ );
+ }
+
+ return $actual;
}
=head2 ldap_mockify
@@ -120,10 +120,10 @@ See L<Test::Net::LDAP::Mock> for more details.
=cut
sub ldap_mockify(&) {
- my ($callback) = @_;
- require Test::Net::LDAP::Mock;
- local *Net::LDAP::new = *Test::Net::LDAP::Mock::new;
- $callback->();
+ my ($callback) = @_;
+ require Test::Net::LDAP::Mock;
+ local *Net::LDAP::new = *Test::Net::LDAP::Mock::new;
+ $callback->();
}
1;
@@ -11,11 +11,11 @@ Test::Net::LDAP - A Net::LDAP subclass for testing
=head1 VERSION
-Version 0.02
+Version 0.03
=cut
-our $VERSION = '0.02';
+our $VERSION = '0.03';
=head1 SYNOPSIS
@@ -5,11 +5,11 @@ use warnings;
use Test::More tests => 8;
use Net::LDAP::Constant qw(
- LDAP_SUCCESS LDAP_NO_SUCH_OBJECT LDAP_ALREADY_EXISTS
+ LDAP_SUCCESS LDAP_NO_SUCH_OBJECT LDAP_ALREADY_EXISTS
);
use Test::Net::LDAP::Mock;
use Test::Net::LDAP::Util qw(
- ldap_result_ok ldap_result_is
+ ldap_result_ok ldap_result_is
);
# Result - status code only
@@ -29,16 +29,16 @@ ldap_result_is($mesg, LDAP_ALREADY_EXISTS);
# Export
{
- package TestPackage1;
- use Test::Net::LDAP::Util qw(ldap_result_is);
+ package TestPackage1;
+ use Test::Net::LDAP::Util qw(ldap_result_is);
}
ok(TestPackage1->can('ldap_result_is'));
ok(!TestPackage1->can('ldap_result_ok'));
{
- package TestPackage2;
- use Test::Net::LDAP::Util qw(:all);
+ package TestPackage2;
+ use Test::Net::LDAP::Util qw(:all);
}
ok(TestPackage2->can('ldap_result_is'));
@@ -2,113 +2,128 @@
use strict;
use warnings;
-use Test::More tests => 35;
+use Test::More tests => 40;
use Net::LDAP;
use Test::Net::LDAP::Util qw(ldap_mockify);
ldap_mockify {
- # ldap1
- for my $ldap (Net::LDAP->new('ldap1.example.com')) {
- is ref($ldap), 'Test::Net::LDAP::Mock';
-
- $ldap->add('uid=user01, dc=example, dc=com');
- $ldap->add('uid=user02, dc=example, dc=com');
-
- my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)');
- is scalar($search->entries), 2;
-
- my $entries = [sort {$a->dn cmp $b->dn} $search->entries];
- is $entries->[0]->dn, 'uid=user01,dc=example,dc=com';
- is $entries->[1]->dn, 'uid=user02,dc=example,dc=com';
- }
-
- # ldap2
- for my $ldap (Net::LDAP->new('ldap2.example.com')) {
- is ref($ldap), 'Test::Net::LDAP::Mock';
-
- $ldap->add('uid=user03, dc=example, dc=com');
- $ldap->add('uid=user04, dc=example, dc=com');
-
- my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)');
- is scalar($search->entries), 2;
-
- my $entries = [sort {$a->dn cmp $b->dn} $search->entries];
- is $entries->[0]->dn, 'uid=user03,dc=example,dc=com';
- is $entries->[1]->dn, 'uid=user04,dc=example,dc=com';
- }
-
- # ldap1, port 3389
- for my $ldap (Net::LDAP->new('ldap1.example.com', port => 3389)) {
- is ref($ldap), 'Test::Net::LDAP::Mock';
-
- $ldap->add('uid=user05, dc=example, dc=com');
- $ldap->add('uid=user06, dc=example, dc=com');
-
- my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)');
- is scalar($search->entries), 2;
-
- my $entries = [sort {$a->dn cmp $b->dn} $search->entries];
- is $entries->[0]->dn, 'uid=user05,dc=example,dc=com';
- is $entries->[1]->dn, 'uid=user06,dc=example,dc=com';
- }
-
- # ldap1, ldaps
- for my $ldap (Net::LDAP->new('ldap1.example.com', scheme => 'ldaps')) {
- is ref($ldap), 'Test::Net::LDAP::Mock';
-
- $ldap->add('uid=user07, dc=example, dc=com');
- $ldap->add('uid=user08, dc=example, dc=com');
-
- my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)');
- is scalar($search->entries), 2;
-
- my $entries = [sort {$a->dn cmp $b->dn} $search->entries];
- is $entries->[0]->dn, 'uid=user07,dc=example,dc=com';
- is $entries->[1]->dn, 'uid=user08,dc=example,dc=com';
- }
-
- # /tmp/ldap1, ldapi
- for my $ldap (Net::LDAP->new('/tmp/ldap1', scheme => 'ldapi')) {
- is ref($ldap), 'Test::Net::LDAP::Mock';
-
- $ldap->add('uid=user09, dc=example, dc=com');
- $ldap->add('uid=user10, dc=example, dc=com');
-
- my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)');
- is scalar($search->entries), 2;
-
- my $entries = [sort {$a->dn cmp $b->dn} $search->entries];
- is $entries->[0]->dn, 'uid=user09,dc=example,dc=com';
- is $entries->[1]->dn, 'uid=user10,dc=example,dc=com';
- }
-
- # /tmp/ldap2, ldapi
- for my $ldap (Net::LDAP->new('/tmp/ldap2', scheme => 'ldapi')) {
- is ref($ldap), 'Test::Net::LDAP::Mock';
-
- $ldap->add('uid=user11, dc=example, dc=com');
- $ldap->add('uid=user12, dc=example, dc=com');
-
- my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)');
- is scalar($search->entries), 2;
-
- my $entries = [sort {$a->dn cmp $b->dn} $search->entries];
- is $entries->[0]->dn, 'uid=user11,dc=example,dc=com';
- is $entries->[1]->dn, 'uid=user12,dc=example,dc=com';
- }
+ # ldap1
+ for my $ldap (Net::LDAP->new('ldap1.example.com')) {
+ is ref($ldap), 'Test::Net::LDAP::Mock';
+
+ $ldap->add('uid=user01, dc=example, dc=com');
+ $ldap->add('uid=user02, dc=example, dc=com');
+
+ my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)');
+ is scalar($search->entries), 2;
+
+ my $entries = [sort {$a->dn cmp $b->dn} $search->entries];
+ is $entries->[0]->dn, 'uid=user01,dc=example,dc=com';
+ is $entries->[1]->dn, 'uid=user02,dc=example,dc=com';
+ }
+
+ # ldap2
+ for my $ldap (Net::LDAP->new('ldap2.example.com')) {
+ is ref($ldap), 'Test::Net::LDAP::Mock';
+
+ $ldap->add('uid=user03, dc=example, dc=com');
+ $ldap->add('uid=user04, dc=example, dc=com');
+
+ my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)');
+ is scalar($search->entries), 2;
+
+ my $entries = [sort {$a->dn cmp $b->dn} $search->entries];
+ is $entries->[0]->dn, 'uid=user03,dc=example,dc=com';
+ is $entries->[1]->dn, 'uid=user04,dc=example,dc=com';
+ }
+
+ # ldap1, port 3389
+ for my $ldap (Net::LDAP->new('ldap1.example.com', port => 3389)) {
+ is ref($ldap), 'Test::Net::LDAP::Mock';
+
+ $ldap->add('uid=user05, dc=example, dc=com');
+ $ldap->add('uid=user06, dc=example, dc=com');
+
+ my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)');
+ is scalar($search->entries), 2;
+
+ my $entries = [sort {$a->dn cmp $b->dn} $search->entries];
+ is $entries->[0]->dn, 'uid=user05,dc=example,dc=com';
+ is $entries->[1]->dn, 'uid=user06,dc=example,dc=com';
+ }
+
+ # ldap1, ldaps
+ for my $ldap (Net::LDAP->new('ldap1.example.com', scheme => 'ldaps')) {
+ is ref($ldap), 'Test::Net::LDAP::Mock';
+
+ $ldap->add('uid=user07, dc=example, dc=com');
+ $ldap->add('uid=user08, dc=example, dc=com');
+
+ my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)');
+ is scalar($search->entries), 2;
+
+ my $entries = [sort {$a->dn cmp $b->dn} $search->entries];
+ is $entries->[0]->dn, 'uid=user07,dc=example,dc=com';
+ is $entries->[1]->dn, 'uid=user08,dc=example,dc=com';
+ }
+
+ # /tmp/ldap1, ldapi
+ for my $ldap (Net::LDAP->new('/tmp/ldap1', scheme => 'ldapi')) {
+ is ref($ldap), 'Test::Net::LDAP::Mock';
+
+ $ldap->add('uid=user09, dc=example, dc=com');
+ $ldap->add('uid=user10, dc=example, dc=com');
+
+ my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)');
+ is scalar($search->entries), 2;
+
+ my $entries = [sort {$a->dn cmp $b->dn} $search->entries];
+ is $entries->[0]->dn, 'uid=user09,dc=example,dc=com';
+ is $entries->[1]->dn, 'uid=user10,dc=example,dc=com';
+ }
+
+ # /tmp/ldap2, ldapi
+ for my $ldap (Net::LDAP->new('/tmp/ldap2', scheme => 'ldapi')) {
+ is ref($ldap), 'Test::Net::LDAP::Mock';
+
+ $ldap->add('uid=user11, dc=example, dc=com');
+ $ldap->add('uid=user12, dc=example, dc=com');
+
+ my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)');
+ is scalar($search->entries), 2;
+
+ my $entries = [sort {$a->dn cmp $b->dn} $search->entries];
+ is $entries->[0]->dn, 'uid=user11,dc=example,dc=com';
+ is $entries->[1]->dn, 'uid=user12,dc=example,dc=com';
+ }
};
ldap_mockify {
- # ldap1 (again)
- for my $ldap (Net::LDAP->new('ldap1.example.com')) {
- is ref($ldap), 'Test::Net::LDAP::Mock';
-
- my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)');
- is scalar($search->entries), 2;
-
- my $entries = [sort {$a->dn cmp $b->dn} $search->entries];
- is $entries->[0]->dn, 'uid=user01,dc=example,dc=com';
- is $entries->[1]->dn, 'uid=user02,dc=example,dc=com';
- }
+ # ldap1 (again)
+ for my $ldap (Net::LDAP->new('ldap1.example.com')) {
+ is ref($ldap), 'Test::Net::LDAP::Mock';
+
+ my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)');
+ is scalar($search->entries), 2;
+
+ my $entries = [sort {$a->dn cmp $b->dn} $search->entries];
+ is $entries->[0]->dn, 'uid=user01,dc=example,dc=com';
+ is $entries->[1]->dn, 'uid=user02,dc=example,dc=com';
+ }
+};
+
+ldap_mockify {
+ # Net::LDAP->new() can take an array ref as hostnames.
+ # In that case, the first one should be used.
+ for my $ldap (Net::LDAP->new(['ldap1.example.com', 'ldap2.example.com'])) {
+ is ref($ldap), 'Test::Net::LDAP::Mock';
+
+ my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)');
+ is scalar($search->entries), 2;
+
+ my $entries = [sort {$a->dn cmp $b->dn} $search->entries];
+ is $entries->[0]->dn, 'uid=user01,dc=example,dc=com';
+ is $entries->[1]->dn, 'uid=user02,dc=example,dc=com';
+ }
};
@@ -5,51 +5,51 @@ use warnings;
use Test::More tests => 4;
use Net::LDAP::Constant qw(
- LDAP_ALREADY_EXISTS
+ LDAP_ALREADY_EXISTS
);
use Test::Builder;
use Test::Net::LDAP::Mock;
sub test_name_is(&$) {
- my ($callback, $expected) = @_;
- my $last_name;
- {
- no warnings 'redefine';
-
- local *Test::Builder::ok = sub {
- my ($self, $test, $name) = @_;
- $last_name = $name;
- };
-
- local *Test::Builder::diag = sub {};
-
- $callback->();
- }
-
- local $Test::Builder::Level = $Test::Builder::Level + 1;
- is $last_name, $expected;
+ my ($callback, $expected) = @_;
+ my $last_name;
+ {
+ no warnings 'redefine';
+
+ local *Test::Builder::ok = sub {
+ my ($self, $test, $name) = @_;
+ $last_name = $name;
+ };
+
+ local *Test::Builder::diag = sub {};
+
+ $callback->();
+ }
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ is $last_name, $expected;
}
my $ldap = Test::Net::LDAP::Mock->new;
test_name_is {
- $ldap->method_ok('search', base => 'dc=example, dc=com');
+ $ldap->method_ok('search', base => 'dc=example, dc=com');
} 'search(base => "dc=example, dc=com")';
test_name_is {
- $ldap->method_ok('search', [
- base => 'dc=example, dc=com', scope => 'sub',
- filter => '(uid=*)', attrs => [qw(uid cn)],
- ]);
+ $ldap->method_ok('search', [
+ base => 'dc=example, dc=com', scope => 'sub',
+ filter => '(uid=*)', attrs => [qw(uid cn)],
+ ]);
} qq{search(base => "dc=example, dc=com", scope => "sub", filter => "(uid=*)")};
test_name_is {
- $ldap->method_ok('add', 'uid=user, dc=example, dc=com');
+ $ldap->method_ok('add', 'uid=user, dc=example, dc=com');
} qq{add(dn => "uid=user, dc=example, dc=com")};
test_name_is {
- $ldap->method_is('add', [
- dn => 'uid=user, dc=example, dc=com',
- attrs => [cn => 'User'],
- ], LDAP_ALREADY_EXISTS);
+ $ldap->method_is('add', [
+ dn => 'uid=user, dc=example, dc=com',
+ attrs => [cn => 'User'],
+ ], LDAP_ALREADY_EXISTS);
} qq{add(dn => "uid=user, dc=example, dc=com")};
@@ -5,8 +5,8 @@ use warnings;
use Test::More tests => 70;
use Net::LDAP::Constant qw(
- LDAP_SUCCESS LDAP_NO_SUCH_OBJECT
- LDAP_PARAM_ERROR LDAP_INVALID_DN_SYNTAX
+ LDAP_SUCCESS LDAP_NO_SUCH_OBJECT
+ LDAP_PARAM_ERROR LDAP_INVALID_DN_SYNTAX
);
use Test::Net::LDAP::Mock::Data;
@@ -17,28 +17,28 @@ my $attrs;
# Prepare entries
$data->add_ok('uid=user1, ou=abc, dc=example, dc=com', attrs => [
- cn => 'foo',
- sn => 'user',
+ cn => 'foo',
+ sn => 'user',
]);
$data->add_ok('uid=user2, ou=abc, dc=example, dc=com', attrs => [
- cn => 'bar',
- sn => 'user',
+ cn => 'bar',
+ sn => 'user',
]);
$data->add_ok('uid=user3, ou=def, dc=example, dc=com', attrs => [
- cn => 'foo',
- sn => 'user',
+ cn => 'foo',
+ sn => 'user',
]);
$data->add_ok('uid=user4, ou=def, dc=example, dc=com', attrs => [
- cn => 'bar',
- sn => 'user',
+ cn => 'bar',
+ sn => 'user',
]);
# scope => 'base'
$search = $data->search_ok(
- base => 'uid=user1, ou=abc, dc=example, dc=com', scope => 'base'
+ base => 'uid=user1, ou=abc, dc=example, dc=com', scope => 'base'
);
$entries = [sort {$a->dn cmp $b->dn} $search->entries];
@@ -48,7 +48,7 @@ is($entries->[0]->dn, 'uid=user1,ou=abc,dc=example,dc=com');
# scope => 'one'
$search = $data->search_ok(
- base => 'ou=abc, dc=example, dc=com', scope => 'one'
+ base => 'ou=abc, dc=example, dc=com', scope => 'one'
);
$entries = [sort {$a->dn cmp $b->dn} $search->entries];
@@ -58,8 +58,8 @@ is($entries->[0]->dn, 'uid=user1,ou=abc,dc=example,dc=com');
is($entries->[1]->dn, 'uid=user2,ou=abc,dc=example,dc=com');
$search = $data->search_ok(
- base => 'ou=abc, dc=example, dc=com', scope => 'one',
- filter => '(cn=bar)'
+ base => 'ou=abc, dc=example, dc=com', scope => 'one',
+ filter => '(cn=bar)'
);
$entries = [sort {$a->dn cmp $b->dn} $search->entries];
@@ -69,7 +69,7 @@ is($entries->[0]->dn, 'uid=user2,ou=abc,dc=example,dc=com');
# scope => 'sub'
$search = $data->search_ok(
- base => 'dc=example, dc=com', scope => 'sub'
+ base => 'dc=example, dc=com', scope => 'sub'
);
$entries = [sort {$a->dn cmp $b->dn} $search->entries];
@@ -81,8 +81,8 @@ is($entries->[2]->dn, 'uid=user3,ou=def,dc=example,dc=com');
is($entries->[3]->dn, 'uid=user4,ou=def,dc=example,dc=com');
$search = $data->search_ok(
- base => 'dc=example, dc=com', scope => 'sub',
- filter => '(cn=bar)'
+ base => 'dc=example, dc=com', scope => 'sub',
+ filter => '(cn=bar)'
);
$entries = [sort {$a->dn cmp $b->dn} $search->entries];
@@ -93,8 +93,8 @@ is($entries->[1]->dn, 'uid=user4,ou=def,dc=example,dc=com');
# All attributes
$search = $data->search_ok(
- base => 'ou=abc, dc=example, dc=com', scope => 'one',
- filter => '(uid=user1)'
+ base => 'ou=abc, dc=example, dc=com', scope => 'one',
+ filter => '(uid=user1)'
);
$entries = [sort {$a->dn cmp $b->dn} $search->entries];
@@ -112,8 +112,8 @@ is($entries->[0]->get_value('uid'), 'user1');
# Limited attributes
$search = $data->search_ok(
- base => 'ou=abc, dc=example, dc=com', scope => 'one',
- filter => '(uid=user1)', attrs => [qw(cn sn)],
+ base => 'ou=abc, dc=example, dc=com', scope => 'one',
+ filter => '(uid=user1)', attrs => [qw(cn sn)],
);
$entries = [sort {$a->dn cmp $b->dn} $search->entries];
@@ -132,11 +132,11 @@ is($entries->[0]->get_value('uid'), undef);
my @callback_args;
$search = $data->search_ok(
- base => 'dc=example, dc=com', scope => 'sub',
- filter => '(cn=foo)', attrs => [qw(cn sn)],
- callback => sub {
- push @callback_args, \@_;
- },
+ base => 'dc=example, dc=com', scope => 'sub',
+ filter => '(cn=foo)', attrs => [qw(cn sn)],
+ callback => sub {
+ push @callback_args, \@_;
+ },
);
is(scalar(@callback_args), 3);
@@ -169,5 +169,5 @@ $data->search_is([filter => undef], LDAP_SUCCESS);
# Error: base dn does not exist
$data->search_is([
- base => 'ou=invalid, dc=example, dc=com', scope => 'one',
+ base => 'ou=invalid, dc=example, dc=com', scope => 'one',
], LDAP_NO_SUCH_OBJECT);
@@ -5,10 +5,10 @@ use warnings;
use Test::More tests => 31;
use Net::LDAP::Constant qw(
- LDAP_SUCCESS
- LDAP_PARAM_ERROR
- LDAP_INVALID_DN_SYNTAX
- LDAP_ALREADY_EXISTS
+ LDAP_SUCCESS
+ LDAP_PARAM_ERROR
+ LDAP_INVALID_DN_SYNTAX
+ LDAP_ALREADY_EXISTS
);
use Net::LDAP::Entry;
use Net::LDAP::Util qw(canonical_dn);
@@ -20,13 +20,13 @@ my $search;
# Add an entry
$data->add_ok('uid=user1, dc=example, dc=com', attrs => [
- sn => 'User',
- cn => 'One',
+ sn => 'User',
+ cn => 'One',
]);
$search = $data->search_ok(
- base => 'dc=example, dc=com', scope => 'one',
- filter => '(uid=*)', attrs => [qw(uid sn cn)],
+ base => 'dc=example, dc=com', scope => 'one',
+ filter => '(uid=*)', attrs => [qw(uid sn cn)],
);
is(scalar($search->entries), 1);
@@ -37,18 +37,18 @@ is($search->entry->get_value('cn'), 'One');
# Add more entries
$data->add_ok('uid=user2, dc=example, dc=com', attrs => [
- sn => 'User',
- cn => 'Two',
+ sn => 'User',
+ cn => 'Two',
]);
$data->add_ok('uid=user3, dc=example, dc=com', attrs => [
- sn => 'User',
- cn => 'Three',
+ sn => 'User',
+ cn => 'Three',
]);
$search = $data->search_ok(
- base => 'dc=example, dc=com', scope => 'one',
- filter => '(uid=*)', attrs => [qw(uid sn cn)],
+ base => 'dc=example, dc=com', scope => 'one',
+ filter => '(uid=*)', attrs => [qw(uid sn cn)],
);
is(scalar($search->entries), 3);
@@ -71,9 +71,9 @@ is($entries[2]->get_value('cn'), 'Three');
my @callback_args;
my $mesg = $data->add_ok('uid=user4, dc=example, dc=com',
- callback => sub {
- push @callback_args, \@_;
- }
+ callback => sub {
+ push @callback_args, \@_;
+ }
);
is(scalar(@callback_args), 1);
@@ -82,19 +82,19 @@ cmp_ok($callback_args[0][0], '==', $mesg);
# Error: dn is missing
$data->add_is([attrs => [
- cn => 'Test']
+ cn => 'Test']
], LDAP_PARAM_ERROR);
# Error: dn is invalid
$data->add_is(['invalid', attrs => [
- cn => 'Test'
+ cn => 'Test'
]], LDAP_INVALID_DN_SYNTAX);
$data->add_is([dn => 'invalid', attrs => [
- cn => 'Test'
+ cn => 'Test'
]], LDAP_INVALID_DN_SYNTAX);
# Error: Attempt to add a duplicate
$data->add_is(['uid=user1, dc=example, dc=com', attrs => [
- cn => 'Test'
+ cn => 'Test'
]], LDAP_ALREADY_EXISTS);
@@ -5,10 +5,10 @@ use warnings;
use Test::More tests => 77;
use Net::LDAP::Constant qw(
- LDAP_SUCCESS
- LDAP_PARAM_ERROR
- LDAP_INVALID_DN_SYNTAX
- LDAP_NO_SUCH_OBJECT
+ LDAP_SUCCESS
+ LDAP_PARAM_ERROR
+ LDAP_INVALID_DN_SYNTAX
+ LDAP_NO_SUCH_OBJECT
);
use Net::LDAP::Entry;
use Test::Net::LDAP::Mock::Data;
@@ -21,12 +21,12 @@ $data->add_ok('uid=user1, dc=example, dc=com');
# Add attributes (1)
$data->modify_ok('uid=user1, dc=example, dc=com',
- add => {myattr1 => 'value1.1', myattr2 => ['value2.1', 'value2.2']}
+ add => {myattr1 => 'value1.1', myattr2 => ['value2.1', 'value2.2']}
);
$search = $data->search_ok(
- base => 'dc=example, dc=com', scope => 'one',
- filter => '(uid=user1)', attrs => [qw(myattr1 myattr2)],
+ base => 'dc=example, dc=com', scope => 'one',
+ filter => '(uid=user1)', attrs => [qw(myattr1 myattr2)],
);
is(scalar($search->entries), 1);
@@ -36,12 +36,12 @@ is_deeply([$search->entry->get_value('myattr2')], ['value2.1', 'value2.2']);
# Add attributes (2)
$data->modify_ok('uid=user1, dc=example, dc=com',
- add => [myattr1 => ['value1.2'], myattr2 => 'value2.3']
+ add => [myattr1 => ['value1.2'], myattr2 => 'value2.3']
);
$search = $data->search_ok(
- base => 'dc=example, dc=com', scope => 'one',
- filter => '(uid=user1)', attrs => [qw(myattr1 myattr2)],
+ base => 'dc=example, dc=com', scope => 'one',
+ filter => '(uid=user1)', attrs => [qw(myattr1 myattr2)],
);
is(scalar($search->entries), 1);
@@ -51,12 +51,12 @@ is_deeply([$search->entry->get_value('myattr2')], ['value2.1', 'value2.2', 'valu
# Replace attributes (1)
$data->modify_ok('uid=user1, dc=example, dc=com',
- replace => {myattr2 => 'value2.4', myattr3 => ['value3.1', 'value3.2']}
+ replace => {myattr2 => 'value2.4', myattr3 => ['value3.1', 'value3.2']}
);
$search = $data->search_ok(
- base => 'dc=example, dc=com', scope => 'one',
- filter => '(uid=user1)', attrs => [qw(myattr1 myattr2 myattr3)],
+ base => 'dc=example, dc=com', scope => 'one',
+ filter => '(uid=user1)', attrs => [qw(myattr1 myattr2 myattr3)],
);
is(scalar($search->entries), 1);
@@ -67,12 +67,12 @@ is_deeply([$search->entry->get_value('myattr3')], ['value3.1', 'value3.2']);
# Replace attributes (2)
$data->modify_ok('uid=user1, dc=example, dc=com',
- replace => [myattr3 => ['value3.3', 'value3.4'], myattr4 => 'value4.1']
+ replace => [myattr3 => ['value3.3', 'value3.4'], myattr4 => 'value4.1']
);
$search = $data->search_ok(
- base => 'dc=example, dc=com', scope => 'one',
- filter => '(uid=user1)', attrs => [qw(myattr1 myattr2 myattr3 myattr4)],
+ base => 'dc=example, dc=com', scope => 'one',
+ filter => '(uid=user1)', attrs => [qw(myattr1 myattr2 myattr3 myattr4)],
);
is(scalar($search->entries), 1);
@@ -84,12 +84,12 @@ is_deeply([$search->entry->get_value('myattr4')], ['value4.1']);
# Delete attributes (1)
$data->modify_ok('uid=user1, dc=example, dc=com',
- delete => ['myattr1', 'myattr2']
+ delete => ['myattr1', 'myattr2']
);
$search = $data->search_ok(
- base => 'dc=example, dc=com', scope => 'one',
- filter => '(uid=user1)', attrs => [qw(myattr1 myattr2 myattr3 myattr4)],
+ base => 'dc=example, dc=com', scope => 'one',
+ filter => '(uid=user1)', attrs => [qw(myattr1 myattr2 myattr3 myattr4)],
);
is(scalar($search->entries), 1);
@@ -101,12 +101,12 @@ is_deeply([$search->entry->get_value('myattr4')], ['value4.1']);
# Delete attributes (2)
$data->modify_ok('uid=user1, dc=example, dc=com',
- delete => {myattr3 => ['value3.4'], myattr4 => []}
+ delete => {myattr3 => ['value3.4'], myattr4 => []}
);
$search = $data->search_ok(
- base => 'dc=example, dc=com', scope => 'one',
- filter => '(uid=user1)', attrs => [qw(myattr1 myattr2 myattr3 myattr4)],
+ base => 'dc=example, dc=com', scope => 'one',
+ filter => '(uid=user1)', attrs => [qw(myattr1 myattr2 myattr3 myattr4)],
);
is(scalar($search->entries), 1);
@@ -118,16 +118,16 @@ is($search->entry->get_value('myattr4'), undef);
# Increment attributes (1)
$data->modify_ok('uid=user1, dc=example, dc=com',
- add => {mynum1 => 100, mynum2 => [200, 300]}
+ add => {mynum1 => 100, mynum2 => [200, 300]}
);
$data->modify_ok('uid=user1, dc=example, dc=com',
- increment => {mynum1 => 22, mynum2 => 55}
+ increment => {mynum1 => 22, mynum2 => 55}
);
$search = $data->search_ok(
- base => 'dc=example, dc=com', scope => 'one',
- filter => '(uid=user1)', attrs => [qw(mynum1 mynum2)],
+ base => 'dc=example, dc=com', scope => 'one',
+ filter => '(uid=user1)', attrs => [qw(mynum1 mynum2)],
);
is(scalar($search->entries), 1);
@@ -137,12 +137,12 @@ is_deeply([$search->entry->get_value('mynum2')], [255, 355]);
# Increment attributes (2)
$data->modify_ok('uid=user1, dc=example, dc=com',
- increment => [mynum1 => -11, mynum2 => -22]
+ increment => [mynum1 => -11, mynum2 => -22]
);
$search = $data->search_ok(
- base => 'dc=example, dc=com', scope => 'one',
- filter => '(uid=user1)', attrs => [qw(mynum1 mynum2)],
+ base => 'dc=example, dc=com', scope => 'one',
+ filter => '(uid=user1)', attrs => [qw(mynum1 mynum2)],
);
is(scalar($search->entries), 1);
@@ -152,23 +152,23 @@ is_deeply([$search->entry->get_value('mynum2')], [233, 333]);
# Changes
$data->modify_ok('uid=user1, dc=example, dc=com',
- add => {
- a1 => 'v1.1',
- r1 => ['v1.1', 'v1.2'],
- d1 => ['v1.1', 'v1.2'],
- d2 => ['v2.1', 'v2.2'],
- }
+ add => {
+ a1 => 'v1.1',
+ r1 => ['v1.1', 'v1.2'],
+ d1 => ['v1.1', 'v1.2'],
+ d2 => ['v2.1', 'v2.2'],
+ }
);
$data->modify_ok('uid=user1, dc=example, dc=com', changes => [
- add => [a1 => 'v1.2', a2 => 'v2.1'],
- replace => [r1 => 'v1.3', r2 => ['v2.1', 'v2.2']],
- delete => [d1 => 'v1.1', d2 => []],
+ add => [a1 => 'v1.2', a2 => 'v2.1'],
+ replace => [r1 => 'v1.3', r2 => ['v2.1', 'v2.2']],
+ delete => [d1 => 'v1.1', d2 => []],
]);
$search = $data->search_ok(
- base => 'dc=example, dc=com', scope => 'one',
- filter => '(uid=user1)', attrs => [qw(a1 a2 r1 r2 d1 d2)],
+ base => 'dc=example, dc=com', scope => 'one',
+ filter => '(uid=user1)', attrs => [qw(a1 a2 r1 r2 d1 d2)],
);
is(scalar($search->entries), 1);
@@ -184,12 +184,12 @@ is_deeply([$search->entry->get_value('d2')], []);
my @callback_args;
my $mesg = $data->modify_ok('uid=user1, dc=example, dc=com',
- add => [
- callback1 => 'value1',
- ],
- callback => sub {
- push @callback_args, \@_;
- }
+ add => [
+ callback1 => 'value1',
+ ],
+ callback => sub {
+ push @callback_args, \@_;
+ }
);
is(scalar(@callback_args), 1);
@@ -198,25 +198,25 @@ cmp_ok($callback_args[0][0], '==', $mesg);
# Error: dn is missing
$data->modify_is([
- replace => [cn => 'Test']
+ replace => [cn => 'Test']
], LDAP_PARAM_ERROR);
# Error: dn is invalid
$data->modify_is(['invalid',
- replace => [cn => 'Test']
+ replace => [cn => 'Test']
], LDAP_INVALID_DN_SYNTAX);
$data->modify_is([
- dn => 'invalid',
- replace => [cn => 'Test']
+ dn => 'invalid',
+ replace => [cn => 'Test']
], LDAP_INVALID_DN_SYNTAX);
# Error: change type is invalid
$data->modify_is(['uid=user1, dc=example, dc=com',
- changes => [invalid => 'test']
+ changes => [invalid => 'test']
], LDAP_PARAM_ERROR);
# Error: Attempt to modify an entry that does not exist
$data->modify_is(['uid=nobody, dc=example, dc=com',
- add => {myattr1 => 'value1.1', myattr2 => ['value2.1', 'value2.2']}
+ add => {myattr1 => 'value1.1', myattr2 => ['value2.1', 'value2.2']}
], LDAP_NO_SUCH_OBJECT);
@@ -5,10 +5,10 @@ use warnings;
use Test::More tests => 35;
use Net::LDAP::Constant qw(
- LDAP_SUCCESS
- LDAP_PARAM_ERROR
- LDAP_INVALID_DN_SYNTAX
- LDAP_NO_SUCH_OBJECT
+ LDAP_SUCCESS
+ LDAP_PARAM_ERROR
+ LDAP_INVALID_DN_SYNTAX
+ LDAP_NO_SUCH_OBJECT
);
use Net::LDAP::Entry;
use Test::Net::LDAP::Mock::Data;
@@ -19,20 +19,20 @@ my @entries;
# Prepare user1, user2, user3
$data->add_ok('uid=user1, dc=example, dc=com', attrs => [
- uid => 'user1',
+ uid => 'user1',
]);
$data->add_ok('uid=user2, dc=example, dc=com', attrs => [
- uid => 'user2',
+ uid => 'user2',
]);
$data->add_ok('uid=user3, dc=example, dc=com', attrs => [
- uid => 'user3',
+ uid => 'user3',
]);
$search = $data->search_ok(
- base => 'dc=example, dc=com', scope => 'one',
- filter => '(uid=*)', attrs => [qw(uid)],
+ base => 'dc=example, dc=com', scope => 'one',
+ filter => '(uid=*)', attrs => [qw(uid)],
);
is(scalar($search->entries), 3);
@@ -48,8 +48,8 @@ is($entries[2]->get_value('uid'), 'user3');
$data->delete_ok('uid=user2, dc=example, dc=com');
$search = $data->search_ok(
- base => 'dc=example, dc=com', scope => 'one',
- filter => '(uid=*)', attrs => [qw(uid)],
+ base => 'dc=example, dc=com', scope => 'one',
+ filter => '(uid=*)', attrs => [qw(uid)],
);
is(scalar($search->entries), 2);
@@ -63,8 +63,8 @@ is($entries[1]->get_value('uid'), 'user3');
$data->delete_ok('uid=user1, dc=example, dc=com');
$search = $data->search_ok(
- base => 'dc=example, dc=com', scope => 'one',
- filter => '(uid=*)', attrs => [qw(uid)],
+ base => 'dc=example, dc=com', scope => 'one',
+ filter => '(uid=*)', attrs => [qw(uid)],
);
is(scalar($search->entries), 1);
@@ -76,8 +76,8 @@ is($entries[0]->get_value('uid'), 'user3');
$data->delete_ok('uid=user3, dc=example, dc=com');
$search = $data->search_ok(
- base => 'dc=example, dc=com', scope => 'one',
- filter => '(uid=*)', attrs => [qw(uid)],
+ base => 'dc=example, dc=com', scope => 'one',
+ filter => '(uid=*)', attrs => [qw(uid)],
);
is(scalar($search->entries), 0);
@@ -87,9 +87,9 @@ $data->add_ok('uid=cb1, dc=example, dc=com');
my @callback_args;
my $mesg = $data->delete_ok('uid=cb1, dc=example, dc=com',
- callback => sub {
- push @callback_args, \@_;
- }
+ callback => sub {
+ push @callback_args, \@_;
+ }
);
is(scalar(@callback_args), 1);
@@ -5,11 +5,11 @@ use warnings;
use Test::More tests => 41;
use Net::LDAP::Constant qw(
- LDAP_SUCCESS
- LDAP_PARAM_ERROR
- LDAP_INVALID_DN_SYNTAX
- LDAP_NO_SUCH_OBJECT
- LDAP_ALREADY_EXISTS
+ LDAP_SUCCESS
+ LDAP_PARAM_ERROR
+ LDAP_INVALID_DN_SYNTAX
+ LDAP_NO_SUCH_OBJECT
+ LDAP_ALREADY_EXISTS
);
use Net::LDAP::Entry;
use Test::Net::LDAP::Mock::Data;
@@ -22,8 +22,8 @@ my $search;
$data->add_ok('uid=user1, dc=example, dc=com');
$search = $data->search_ok(
- base => 'dc=com', scope => 'sub',
- filter => '(uid=user*)', attrs => [qw(uid)],
+ base => 'dc=com', scope => 'sub',
+ filter => '(uid=user*)', attrs => [qw(uid)],
);
is(scalar($search->entries), 1);
@@ -32,13 +32,13 @@ is($search->entry->get_value('uid'), 'user1');
# newrdn
$data->moddn_ok('uid=user1, dc=example, dc=com',
- newrdn => 'uid=user2',
- deleteoldrdn => 0,
+ newrdn => 'uid=user2',
+ deleteoldrdn => 0,
);
$search = $data->search_ok(
- base => 'dc=com', scope => 'sub',
- filter => '(uid=user*)', attrs => [qw(uid)],
+ base => 'dc=com', scope => 'sub',
+ filter => '(uid=user*)', attrs => [qw(uid)],
);
is(scalar($search->entries), 1);
@@ -47,13 +47,13 @@ is_deeply([sort $search->entry->get_value('uid')], ['user1', 'user2']);
# newrdn, deleteoldrdn
$data->moddn_ok('uid=user2, dc=example, dc=com',
- newrdn => 'uid=user3',
- deleteoldrdn => 1,
+ newrdn => 'uid=user3',
+ deleteoldrdn => 1,
);
$search = $data->search_ok(
- base => 'dc=com', scope => 'sub',
- filter => '(uid=user*)', attrs => [qw(uid)],
+ base => 'dc=com', scope => 'sub',
+ filter => '(uid=user*)', attrs => [qw(uid)],
);
is(scalar($search->entries), 1);
@@ -62,12 +62,12 @@ is_deeply([sort $search->entry->get_value('uid')], ['user1', 'user3']);
# newsuperior
$data->moddn_ok('uid=user3, dc=example, dc=com',
- newsuperior => 'dc=example2, dc=com',
+ newsuperior => 'dc=example2, dc=com',
);
$search = $data->search_ok(
- base => 'dc=com', scope => 'sub',
- filter => '(uid=user*)', attrs => [qw(uid)],
+ base => 'dc=com', scope => 'sub',
+ filter => '(uid=user*)', attrs => [qw(uid)],
);
is(scalar($search->entries), 1);
@@ -76,14 +76,14 @@ is_deeply([sort $search->entry->get_value('uid')], ['user1', 'user3']);
# newsuperior, newrdn
$data->moddn_ok('uid=user3, dc=example2, dc=com',
- newsuperior => 'dc=example3, dc=com',
- newrdn => 'uid=user4',
- deleteoldrdn => 1,
+ newsuperior => 'dc=example3, dc=com',
+ newrdn => 'uid=user4',
+ deleteoldrdn => 1,
);
$search = $data->search_ok(
- base => 'dc=com', scope => 'sub',
- filter => '(uid=user*)', attrs => [qw(uid)],
+ base => 'dc=com', scope => 'sub',
+ filter => '(uid=user*)', attrs => [qw(uid)],
);
is(scalar($search->entries), 1);
@@ -95,10 +95,10 @@ $data->add_ok('uid=cb1, dc=example, dc=com');
my @callback_args;
$mesg = $data->modify_ok('uid=cb1, dc=example, dc=com',
- newrdn => 'uid=cb2',
- callback => sub {
- push @callback_args, \@_;
- }
+ newrdn => 'uid=cb2',
+ callback => sub {
+ push @callback_args, \@_;
+ }
);
is(scalar(@callback_args), 1);
@@ -112,43 +112,43 @@ $data->add_ok('uid=user2, dc=example2, dc=com');
# Error: dn is missing
$data->moddn_is([
- newrdn => 'uid=user2'
+ newrdn => 'uid=user2'
], LDAP_PARAM_ERROR);
# Error: dn is invalid
$data->moddn_is(['invalid',
- newrdn => 'uid=user2'
+ newrdn => 'uid=user2'
], LDAP_INVALID_DN_SYNTAX);
$data->moddn_is([
- dn => 'invalid',
- newrdn => 'uid=user2'
+ dn => 'invalid',
+ newrdn => 'uid=user2'
], LDAP_INVALID_DN_SYNTAX);
# Error: newrdn is invalid
$data->moddn_is([
- dn => 'uid=user1, dc=example1, dc=com',
- newrdn => 'invalid'
+ dn => 'uid=user1, dc=example1, dc=com',
+ newrdn => 'invalid'
], LDAP_INVALID_DN_SYNTAX);
# Error: newsuperior is invalid
$data->moddn_is([
- dn => 'uid=user1, dc=example1, dc=com',
- newrdn => 'uid=user3',
- newsuperior => 'invalid',
+ dn => 'uid=user1, dc=example1, dc=com',
+ newrdn => 'uid=user3',
+ newsuperior => 'invalid',
], LDAP_INVALID_DN_SYNTAX);
# Error: Attempt to modify an entry that does not exist
$data->moddn_is(['uid=invalid, dc=example, dc=com',
- newrdn => 'uid=user1',
+ newrdn => 'uid=user1',
], LDAP_NO_SUCH_OBJECT);
# Error: Attempt to move DN to an already existing destination
$data->moddn_is(['uid=user1, dc=example1, dc=com',
- newrdn => 'uid=user2',
+ newrdn => 'uid=user2',
], LDAP_ALREADY_EXISTS);
$data->moddn_is(['uid=user1, dc=example1, dc=com',
- newrdn => 'uid=user2',
- newsuperior => 'dc=example2, dc=com',
+ newrdn => 'uid=user2',
+ newsuperior => 'dc=example2, dc=com',
], LDAP_ALREADY_EXISTS);
@@ -5,8 +5,8 @@ use warnings;
use Test::More tests => 14;
use Net::LDAP::Constant qw(
- LDAP_COMPARE_TRUE LDAP_COMPARE_FALSE
- LDAP_PARAM_ERROR LDAP_INVALID_DN_SYNTAX LDAP_NO_SUCH_OBJECT
+ LDAP_COMPARE_TRUE LDAP_COMPARE_FALSE
+ LDAP_PARAM_ERROR LDAP_INVALID_DN_SYNTAX LDAP_NO_SUCH_OBJECT
);
use Test::Net::LDAP::Mock::Data;
@@ -14,28 +14,28 @@ my $data = Test::Net::LDAP::Mock::Data->new;
# Prepare data
$data->add_ok('uid=compare1, ou=compare, dc=example, dc=com', attrs => [
- cn => 'Compare 1'
+ cn => 'Compare 1'
]);
# Compare
$data->compare_is(['uid=compare1, ou=compare, dc=example, dc=com',
- attr => 'uid',
- value => 'compare1',
+ attr => 'uid',
+ value => 'compare1',
], LDAP_COMPARE_TRUE);
$data->compare_is(['uid=compare1, ou=compare, dc=example, dc=com',
- attr => 'cn',
- value => 'Compare 1',
+ attr => 'cn',
+ value => 'Compare 1',
], LDAP_COMPARE_TRUE);
$data->compare_is(['uid=compare1, ou=compare, dc=example, dc=com',
- attr => 'cn',
- value => 'Compare 2',
+ attr => 'cn',
+ value => 'Compare 2',
], LDAP_COMPARE_FALSE);
$data->compare_is(['uid=compare1, ou=compare, dc=example, dc=com',
- attr => 'sn',
- value => 'Compare 1',
+ attr => 'sn',
+ value => 'Compare 1',
], LDAP_COMPARE_FALSE);
# Callback
@@ -43,11 +43,11 @@ $data->add_ok('uid=cb1, dc=example, dc=com');
my @callback_args;
my $mesg = $data->compare_is(['uid=cb1, dc=example, dc=com',
- attr => 'uid',
- value => 'cb1',
- callback => sub {
- push @callback_args, \@_;
- }
+ attr => 'uid',
+ value => 'cb1',
+ callback => sub {
+ push @callback_args, \@_;
+ }
], LDAP_COMPARE_TRUE);
is(scalar(@callback_args), 1);
@@ -56,24 +56,24 @@ cmp_ok($callback_args[0][0], '==', $mesg);
# Error: dn is missing
$data->compare_is([
- attr => 'uid',
- value => 'compare1',
+ attr => 'uid',
+ value => 'compare1',
], LDAP_PARAM_ERROR);
# Error: dn is invalid
$data->compare_is(['invalid',
- attr => 'uid',
- value => 'compare1',
+ attr => 'uid',
+ value => 'compare1',
], LDAP_INVALID_DN_SYNTAX);
$data->compare_is([
- dn => 'invalid',
- attr => 'uid',
- value => 'compare1',
+ dn => 'invalid',
+ attr => 'uid',
+ value => 'compare1',
], LDAP_INVALID_DN_SYNTAX);
# Error: Attempt to compare an entry that does not exist
$data->modify_is(['uid=nobody, dc=example, dc=com',
- attr => 'uid',
- value => 'compare1',
+ attr => 'uid',
+ value => 'compare1',
], LDAP_NO_SUCH_OBJECT);
@@ -15,9 +15,9 @@ $data->abandon_ok();
# Root DSE
$data->mock_root_dse(
- namingContexts => 'dc=example,dc=com',
- supportedLDAPVersion => 3,
- subschemaSubentry => 'cn=Subscheme',
+ namingContexts => 'dc=example,dc=com',
+ supportedLDAPVersion => 3,
+ subschemaSubentry => 'cn=Subscheme',
);
ok my $root_dse = $data->root_dse;
@@ -32,7 +32,7 @@ my $mesg;
@callback_args = ();
$mesg = $data->bind_ok(callback => sub {
- push @callback_args, \@_;
+ push @callback_args, \@_;
});
is(scalar(@callback_args), 1);
@@ -43,7 +43,7 @@ cmp_ok($callback_args[0][0], '==', $mesg);
@callback_args = ();
$mesg = $data->unbind_ok(callback => sub {
- push @callback_args, \@_;
+ push @callback_args, \@_;
});
is(scalar(@callback_args), 1);
@@ -54,7 +54,7 @@ cmp_ok($callback_args[0][0], '==', $mesg);
@callback_args = ();
$mesg = $data->abandon_ok(callback => sub {
- push @callback_args, \@_;
+ push @callback_args, \@_;
});
is(scalar(@callback_args), 1);