Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

Testing Wrapped LDAP Classes

by yulivee07 (Sexton)
on Dec 05, 2016 at 15:39 UTC ( #1177236=perlquestion: print w/replies, xml ) Need Help??

yulivee07 has asked for the wisdom of the Perl Monks concerning the following question:

Hello fellow Perl-Monks,

I am expanding my knowledge in testing right now. I want to test some functions of mine which interact with an LDAP-Server.

This might sound like a stupid question, but what is the best way to deal with Wrapper-Classes?

I write a module, which gets some Users from LDAP.
To communicate with the LDAP, I use a provided module from my workplace which wraps some system-specific parameters in the LDAP-methods (Utils::Ldap::CompanyLdap) and provides some additional methods.
This module again is a subclass of another LDAP-Wrapper Module (Utils::Ldap::Base) which finally uses Net::LDAP.

Now, in my program I use the first Ldap-Module e.g.
package MyAwesomeProgram; use Utils::Ldap::CompanyLdap; sub read_users { # code that reads users from Ldap # searchGetEntries/get_value is provided by Utils::Ldap::CompanyLda +p foreach my $entry ( $ldap->searchGetEntries() ) { my $uid = $entry->get_value( 'uid' ); #... do something more } } 1;
I want to test the read_users function of my program, which gets its users via Utils::Ldap::CompanyLdap. How do I mock this? As you see, I do not directly interact with a Net::LDAP-Object

I have already understood that there is Test::Net::LDAP::Mock/Test::Net::LDAP::Utils qw(ldap_mockify) which can mock an Ldap Connection. What I do not understand yet: How can I use this in conjunction with my Wrapper Module? My module uses the code and the functions of our Ldap-Wrappers. Would the correct way be to write mocking code for the wrappers (e.g. Utils::Ldap::CompanyLdap::Mock), or is there a way of overwriting the Net::LDAP Object which is used by the Base-Wrapper Class Utils::Ldap::Base? I am not shure how to best approach this.

Second Question:
In case I get this working, is there a way of taking a Net::LDAP object and feeding it into my Mock-Object? I'd like to copy the datastructe of our LDAP to the Mock-Object.

Kind regards,


Replies are listed 'Best First'.
Re: Testing Wrapped LDAP Classes
by stevieb (Canon) on Dec 05, 2016 at 15:56 UTC

    There are a few mocking distributions on the CPAN, but I'll show an example using my Mock::Sub. You can mock out subs, then tell it to do something (side_effect()), or return something (return_value()). Instead of using a method to set them, you can also specify them in the constructor if you choose (then remove/modify them with the methods later):

    use warnings; use strict; use lib '.'; use Mock::Sub; use Test::More; use Utils::Ldap::CompanyLdap; my $m = Mock::Sub->new; my $ldap = Utils::Ldap::CompanyLdap->new; my $mocked_sub = $m->mock( 'Utils::Ldap::CompanyLdap::searchGetEntries' ); $mocked_sub->return_value(qw(steve mike dave)); read_users(); is $mocked_sub->called, 1, "searchGetEntries() called ok"; sub read_users { for my $entry ($ldap->searchGetEntries()){ print "$entry\n"; } } done_testing();


    steve mike dave ok 1 - searchGetEntries() called ok 1..1
      The Ldap Object looks like this before the searchUser (some details obfuscated):
      $VAR1 = bless( { 'OPT' => { 'base' => somebase, 'idprefix' => 'cn', 'userid' => 'admin', 'charset' => 'ISO-8859-15', 'bindretry' => '3', 'ldaps' => 1, 'timeout' => '60', 'server' => someip, 'waitretry' => '5', } }, 'Utils::Ldap::CompanyLdap' );

      And it looks like that after the searchUser:
      bless( { 's_result' => bless( { 'parent' => bless( { 'net_ldap_version' => '3', 'net_ldap_scheme' => 'ldaps', 'net_ldap_debug' => 0, 'net_ldap_onerror' => sub { "DUMMY" }, 'net_ldap_host' => someip, 'net_ldap_uri' => someip, 'net_ldap_resp' => {}, 'net_ldap_async' => 0, 'net_ldap_port' => 636, 'net_ldap_refcnt' => 0 }, 'Net::LDAPS' ), 'entries' => [ bless( { + + 'changes' => [], 'changetype' => 'modify', 'asn' => { 'objectName' => 'uid=bla,ou=People,ou=foo,dc=bar +,dc=baz,dc=com', 'attributes' => [ {'type' => 'uid', 'vals' => [ someuid ] }, {'type' => 'cnum', 'vals' => [ 'L07345897' ] + }, {'type' => 'freeze','vals' => [ 'false' ] }, {'type' => 'dn', 'vals' => ['uid=bla,c=us, +ou=otherldap,' ] }, {'type' => 'email', 'vals' => ['] }, ] } }, 'Net::LDAP::Entry' ), ], 'errorMessage' => '', 'ctrl_hash' => undef, 'resultCode' => 0, 'callback' => undef, 'matchedDN' => '', 'mesgid' => 2, 'controls' => undef, 'raw' => undef }, 'Net::LDAP::Search' ), 'BIND' => 0, 'errors' => '', 'error' => '', 'OPT' => { 'base' => somebase, 'idprefix' => 'cn', 'userid' => 'admin', 'charset' => 'ISO-8859-15', 'bindretry' => 3, 'ldaps' => 1, 'timeout' => '60', 'server' => someip, 'waitretry' => '5', }, }, 'Utils::Ldap::CompanyLdap' );
      The 'entries' contain all the userids, I have just added one to demonstrate. Normally there would be more.
      Hi stevieb, thanks for your answer! This looks really good and I tried to integrate this into my code. Yet I still have problems...

      I have a subroutine in my program called like this:
      sub search_ldap { + + my ( $self, $ldap ) = @_; # get uid, email, ecufreeze, cnum, itimaccess from LDAP report LOG_INFO, "Reading from Ldap"; unless ( $ldap->searchUser( filter => '(uid=*)', attributes => "freeze uid dn cnum emai +l" ) ) { report LOG_ERROR, "Can not list user from LDAP: " . $ldap->get +Error(); exit 0; } return $ldap; }
      In this case $ldap is a Utils::Ldap::CompanyLdap object. when calling $ldap->searchUser this object writes the users into itself. So with the searchUser call, the object itself is altered.

      What I tried:
      my $m = Mock::Sub->new; my $ldap = Utils::Ldap::CompanyLdap->new; + + + my $mocked_sub = $m->mock( 'Utils::Ldap::CompanyLdap::searchUser' ); # This is actually a Utils::Ldap::CompanyLdap-Object I copied via Data +::Dumper my $return_value = bless ( ... ); $mocked_sub->return_value($return_value); # cache is an instance of my own object + ok( $cache->search_ldap($my_ldap) ); ok( $cache->read_all_userids($my_ldap) ); is $mocked_sub->called, 1, "searchUser() called ok";
      I was hoping that be putting the object the way I want it to into my return value, the solution would work. The thing is, I noticed searchUser doesn't really return anything, it only appends to the object-instance. So Mock::Sub returns the right thing, but the code continues to work with the old ldap-object. Any Ideas how to solve this?

      Greetings and thanks for your insights so far,

        This is what the side_effect() functionality does... allows you to do stuff (eg: modify an object) when there's no need for a return. Here's an example:

        use warnings; use strict; package Thing; { sub new { return bless {}, shift; } sub modify { my ($self) = @_; $self->{modified} = 'modified by original sub'; } } package main; use Data::Dumper; use Mock::Sub; use Test::More; my $m = Mock::Sub->new; my $thing = Thing->new; my $modify_sub = $m->mock('Thing::modify'); $modify_sub->side_effect( sub { my $obj = shift; $obj->{modified} = 'modified by mocked sub'; } ); print "before mocked sub called...\n\n"; print Dumper $thing; $thing->modify; print "\n\nafter mocked sub called...\n\n"; print Dumper $thing; print "\n\n"; is defined $thing->{modified}, 1, "obj was modified ok"; like $thing->{modified}, qr/mocked sub/, "obj was changed by mock"; is $modify_sub->called, 1, "mocked sub called ok"; done_testing();


        before mocked sub called... $VAR1 = bless( {}, 'Thing' ); after mocked sub called... $VAR1 = bless( { 'modified' => 'modified by mocked sub' }, 'Thing' ); ok 1 - obj was modified ok ok 2 - obj was changed by mock ok 3 - mocked sub called ok 1..3

        So, there's no return anymore. The side_effect() code reference will get all parameters passed in as they were sent in to the real sub call (in this case, $self, as it's the only param on the method call. We then have the side effect add a new hash key to itself and assign it a value. After side effect is complete, the main object is updated just like the original function would have done, without having to call the real function.

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1177236]
Approved by kevbot
Front-paged by 1nickt
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others musing on the Monastery: (5)
As of 2023-11-29 07:46 GMT
Find Nodes?
    Voting Booth?

    No recent polls found