File Coverage

blib/lib/Test/Net/LDAP/Util.pm

Criterion	Covered	Total	%
statement	57	63	90.4
branch	10	18	55.5
condition	4	9	44.4
subroutine	13	13	100.0
pod	4	4	100.0
total	88	107	82.2

use 5.006;
use strict;
use warnings;

package Test::Net::LDAP::Util;
use base 'Exporter';
use Net::LDAP;
use Net::LDAP::Constant qw(LDAP_SUCCESS);
use Net::LDAP::Util qw(ldap_error_name ldap_error_text canonical_dn);
use Test::Builder;

our @EXPORT_OK = qw(
    ldap_result_ok
    ldap_result_is
    ldap_mockify
    ldap_dn_is
);

our %EXPORT_TAGS = (all => \@EXPORT_OK);

=head1 NAME

Test::Net::LDAP::Util - Testing utilities for Test::Net::LDAP

=cut

=head1 EXPORT

The following subroutines are exported on demand.

    use Test::Net::LDAP::Util qw(
        ldap_result_ok
        ldap_result_is
        ldap_mockify
        ldap_dn_is
    );

All the subroutines are exported if C<:all> is specified.

    use Test::Net::LDAP::Util ':all';

=cut

=head1 SUBROUTINES

=cut

sub _format_diag {
    my ($actual_text, $expected_text) = @_;

    # Indent spaces are based on Test::Builder::_is_diag implementation
    # ($Test::Builder::VERSION == 0.98)
    return sprintf("%12s: %s\n", 'got', $actual_text).
           sprintf("%12s: %s\n", 'expected', $expected_text);
}

=head2 ldap_result_ok

    ldap_result_ok($mesg, $name);

Tests the result of an LDAP operation to see if the code is C.

C<$mesg> is either a Net::LDAP::Message object returned by LDAP operation
methods or a result code.

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);
}

=head2 ldap_result_is

    ldap_result_is($mesg, $expect, $name);

Tests the result of an LDAP operation to see if the code is equal to C<$expect>.

The values of C<$mesg> and C<$expect> are either a Net::LDAP::Message object
returned by LDAP operation methods or a result code.

C<$name> is the optional test name.

=cut

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.')';

        $test_builder->diag(_format_diag($actual_text, $expected_text));
    }

    return $actual;
}

=head2 ldap_mockify

    ldap_mockify {
        # CODE
    };

Inside the code block (recursively), all the occurrences of C
are replaced by C.

Subclasses of C are also mockified. C is inserted
into C<@ISA> of each subclass, only within the context of C.

See L for more details.

=cut

sub ldap_mockify(&) {
    my ($callback) = @_;
    require Test::Net::LDAP::Mock;
    Test::Net::LDAP::Mock->mockify($callback);
}

=head2 ldap_dn_is

    ldap_dn_is($actual_dn, $expect_dn, $name);

Tests equality of two DNs that are not necessarily canonicalized.

The comparison is case-insensitive.

=cut

sub ldap_dn_is {
    my ($actual_dn, $expected_dn, $name) = @_;
    my ($actual_canonical_dn, $expected_canonical_dn) = ($actual_dn, $expected_dn);

    for my $dn ($actual_canonical_dn, $expected_canonical_dn) {
        $dn = lc canonical_dn($dn, casefold => 'none') if defined $dn;
    }

    my $success;

    if (defined $actual_dn) {
        if (defined $expected_dn) {
            $success = $actual_canonical_dn eq $expected_canonical_dn;
        } else {
            $success = 0;
        }
    } else {
        $success = !defined $expected_dn;
    }

    local $Test::Builder::Level = $Test::Builder::Level + 1;
    $test_builder ||= Test::Builder->new;
    $test_builder->ok($success, $name);

    unless ($success) {
        my ($actual_text, $expected_text) = ($actual_dn, $expected_dn);

        for my $text ($actual_text, $expected_text) {
            $text = defined $text ? "'$text'" : 'undef';
        }

        $test_builder->diag(_format_diag($actual_text, $expected_text));
    }
}

1;