Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Re^1: Testing Wrapped LDAP Classes

by yulivee07 (Sexton)
on Dec 06, 2016 at 11:13 UTC ( [id://1177301]=note: print w/replies, xml ) Need Help??


in reply to Re: Testing Wrapped LDAP Classes
in thread Testing Wrapped LDAP Classes

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,
yulivee

Replies are listed 'Best First'.
Re^2: Testing Wrapped LDAP Classes
by stevieb (Canon) on Dec 06, 2016 at 14:58 UTC

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

    Output:

    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?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1177301]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others taking refuge in the Monastery: (3)
As of 2025-03-27 04:08 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    When you first encountered Perl, which feature amazed you the most?










    Results (69 votes). Check out past polls.

    Notices?
    erzuuliAnonymous Monks are no longer allowed to use Super Search, due to an excessive use of this resource by robots.