i'm trying to do something like this:
-- source file 1
my $queue = Thread::Queue->new();
MyModules::populateQueue(<pass $queue->enqueue method reference);
...
-- package file
package MyModules
sub populateQueue {
my $enqueue = $_[0];
my $item = <find item to add to queue>;
$enqueue->($item);
...
first, i'm not able to add "bless" to Thread::Queue
i've tried a couple of suggestions i found in stackoverflow:
my $enqueueRef = $queue->can('enqueue');
MyModules::populateQueue(\&enqueueRef); <--- fails in the package at line
$enqueue->($item) with undefined subroutine
MyModules::populateQueue(\&queue->enqueue) <-- same failure as above
any idea how to pass a method of an object as a parameter to a function that can then be used in the function?
Perl doesn't have a concept of a bound method reference. my $enqueue = $object->can('method') will return a code ref to a method if it exists, but the code ref isn't bound to that particular object – you still need to pass it as the first argument ($queue->$enqueue($item) or $enqueue->($queue, $item)).
To pass a bound method, the correct solution is to use an anonymous sub that wraps the method call:
populate_queue(sub { $queue->enqueue(#_) });
Related
I am trying to filter a liststore using the GTK2::TreeModelFilter. I can't seem to find an example online that uses perl and I am getting syntax errors. Can someone help me with the syntax below? The $unfiltered_store is a liststore.
$filtered_store = Gtk2::TreeModeFilter->new($unfiltered_store);
$filtered_store->set_visible_func(get_end_products, $unfiltered_store);
$combobox = Gtk2::ComboBoxEntry->new($filtered_store,1);
Then somewhere below:
sub get_end_products {
my ($a, $b) = #_;
warn(Dumper(\$a));
warn(Dumper(\$b));
return true; # Return all rows for now
}
Ultimately what I want to do is look at column 14 of the listore ($unfiltered_store) and if it is a certain value, then it filtered into the $filtered_store.
Can someone help me with the syntax on this? I checked a bunch of sites, but they're in other languages and using different syntax (like 'new_filter' -- doesn't exist with Perl GTK).
This is the most elegant solution to a fix I need to make and I would prefer to learn how to use this rather than using a brute force method of pulling and saving the filtered data.
The set_visible_func method of the filtered store should get a sub reference as the first argument, but you are not passing a sub reference here:
$filtered_store->set_visible_func(get_end_products, $unfiltered_store);
This will instead call the sub routine get_end_products and then pass on its return value (which is not a sub reference). To fix it add the reference operator \& in front of the sub name:
$filtered_store->set_visible_func(\&get_end_products, $unfiltered_store);
Regarding your other question in the comments:
According to the documentation the user data parameter is passed as the third parameter to get_end_products, so you should define it like this:
sub get_end_products {
my ($model, $iter, $user_data) = #_;
# Do something with $user_data
return TRUE;
}
If for some reason $unfiltered_store is not passed on to get_end_products, you can try pass it using an anonymous sub instead, like this:
$filtered_store->set_visible_func(
sub { get_end_products( $unfiltered_store) });
I have inherited some Perl code which contains a line that is mysterious to me:
my $binary = A->current->config->settings('arg1', 'arg2')
Basically, I am not sure how to find the related code. "A" is NOT a variable in the local code so I thought this was a class hierarchy. However I checked the directory structure to see if the following path existed, but there was none:
A/current/config/settings.pm
Is A->current->config->settings guaranteed to be a nested class hierarchy, or could it be something else? For example could config actually be a property or method of a different object A->current?
Any assistance you could lend tracking this down would be greatly appreciated!
A is a class name, you should find it in A.pm. current should be a method of the class, defined under a sub current in A.pm. It returns an object whose config method is being called which returns an object again whose settings method is being called with arguments 'arg1' and 'arg2' (well, in fact, the object itself is the first argument).
In fact, any of the methods can return a class instead of an object, too.
Step through the code in the perl debugger and see where it takes you.
foo->bar is a method call, meaning that there is likely a subroutine called bar defined in the package referred to by foo (or a superclass), and gives you no information about whether there is a package bar or foo::bar.
Is A->current->config->settings guaranteed to be a nested class hierarchy
You're thinking of A::current::config::settings.
The following are method calls:
INVOCANT->name
INVOCANT->name(LIST)
That means that A->current->config->settings is a chain of method calls.
The only class named in that code is A.
could config actually be a property or method of a different object A->current?
It's the name of a method of the object or class returned by A->current.
How to find the Perl code referenced by this line?
my $binary = A->current->config->settings('arg1', 'arg2');
is short for
my $obj1 = A->current;
my $obj2 = $obj1->config;
my $binary = $obj2->settings('arg1', 'arg2');
Now that you have the objects available, you can find the class of which they are an instance using
say ref($obj) || "Not a reference";
or
use Scalar::Util qw( blessed );
say blessed($obj) // "Not an object";
As explained, you are dealing with a chain of method calls in the class named A, where at least the first one is a class method since it is invoked on the class (A) itself, not on an object.
An easy way to find that class is by using Class::Inspector
use Class::Inspector;
say "Filename: ", Class::Inspector->resolved_filename( 'A' );
which printed the full path to the class I used in my tests. Also see loaded_filename.
Another interesting way to interrogate a class is to add to it at runtime.
Create an object of A and add to it a method of your choice at runtime
my $objA = A->new();
eval q( sub A::get_info { print "$_\n" for (caller(0)) } );
if ($#) { print "Eval: $#" };
eval q( sub A::boom { croak "Stacktrace: " } );
if ($#) { print "Eval: $#" };
$objA->get_info();
$objA->boom();
These are simple examples but you can acquire practically any information from inside a method.
If A happens to not have a method called new (possible) work with methods in the given chain, starting with my $objA = A->current.
Or, you can directly add a subroutine to the package's symbol table
*{A::new_method} = sub { say "A new method" };
$any_obj_of_A->new_method();
which is now also available on all existing instances, as well as on new ones.
I am calling a method as follows:
$self->class->method
I would like to pass a reference to this method as a parameter into a subroutine.
I have tried
\&{ $self->class->method }
but I get the following error:
Unable to create sub named ""
Any ideas on how to do this?
You can take a reference to static class method, but in your case you could use anonymous closure to achieve similar,
my $ref = sub { $self->class->method };
# ..
my $result = $ref->();
The class method is a little strange. I would expect a method with a name like that to return the class string, but it clearly returns an object as it has a method method.
I recommend that you use UNIVERSAL::can, which returns a reference to the given method if it exists. So you can write code like this
my $method_ref = $self->class->can('method');
mysub($method_ref);
You can also use the curry module to achieve this:
use curry;
my $mref = $self->class->curry::method;
I am having troubles mocking a subroutine in another module than where I am running the tests.
I have my tests in a file called ParserTests.pl. I am trying to test a subroutine (parse) in a module LogParser.pm
sub parse {
my ($self) = #_;
my $rr = $self->getRR;
while(1) {
my $result = $self->parseCommitSet();
if ($result eq 2) {
last;
}
my $printStatus = $self->printOut($result);
if (!$printStatus) {
say "Problem occurred with writing to output";
return 0;
}
$self->setRR(ReportRecord->new());
}
return 1;
}
I am trying to mock printOut so that it always returns true. What I am trying to do is this:
#! /usr/bin/perl
use v5.10.0;
use strict;
use warnings;
use Test::More 'no_plan';
use Test::MockObject;
use LogParser;
{other tests…}
my $mock = Test::MockObject->new();
$mock->set_true('LogParser::printOut');
my $test100FH = getTestFH($test100SetsNoPrev);
$logParser = LogParser->new($test100FH);
is($logParser->parse, 1, "im ok?");
close $test100FH;
But this test is failing. Can you tell me why and point me in the right path to get it working correctly for when I test parse()? I read up on a bunch of documentation but something like this is still a bit unclear.
The error is
Can't use an undefined value as a symbol reference at /Users/achu/Documents/workspace/Perl_Script/LogParser.pm line 241, <$fh> line 8371.
# Looks like your test exited with 25 just after 91.
That line (line 241) is inside the printOut subroutine though which means that it's not mocking that subroutine like I wanted it to. What am I doing wrong?
Test::MockModule is probably better suited to this;
my $module = Test::MockModule->new('LogParser');
$module->mock( printOut => sub { return 1 } );
This will cause LogParser to use your mocked version until $module goes out of scope.
Test::MockObject does not quite do what you want. It is good for supplying a minimally-implemented stub. But for making an instance of the class under test and selectively overriding its methods, you want Test::MockObject::Extends.
TMOE takes an instance and then lets you change what some of its methods do. In your example, you can use it to write the test thus:
use Test::MockObject::Extends;
my $test100FH = getTestFH($test100SetsNoPrev);
$logParser = Test::MockObject::Extends->new(
LogParser->new($test100FH);
);
$logParser->set_true('printOut');
is($logParser->parse, 1, "im ok?");
close $test100FH;
You didn't provide the error message, but what you've defined is an object called $mock that contains a 'printout' method. But you're calling printout() on $logparser.
The point of MockObject is to create a very bare object, with a few methods so you can test other pieces of code in a algorithm that relies on an external object. For example, you could mock a database handle so that calling $dbh->fetchStuff() always returns on static row, so that you can test the code that consumes the row.
So without more context, I can't tell the possibilities for just creating a stub for printOut() so that parse knows about it.
That being said, I also don't understand the desire to have a test for the return value of the stubbed method.
Please read the documentation for Test::MockObject and try to understand how it works.
You are doing only the first half of what is actually required: You are creating a mock object. But this will not magically end up in your LogParser.
What Test::MockObject gives you is an object that behaves just like the object you want to mock. Of course, somebody or something still has to use that object. And this will have to be the code you are trying to test.
I'm using MockObjects in some of my tests and just had to test a function with a call to a SUPER class and I cannot seem to make it work. Can UNIVERSAL calls like $this->SUPER::save() not be mocked? If yes, how do you do it?
Thanks.
Edit:
Found it!
Use fake_module from Test::MockObject
So, let's say your base module it Some::Module, and your subroutine is making a $this->SUPER::save call, use
my $child_class_mockup = Test::MockObject->new();
$child_class_mockup->fake_module(
'Some::Module',
save => sub () { return 1; }
);
Leaving the question open for a couple of days, to get inputs about different ways/libraries of doing this (what if, the SUPER call had a SUPER call?) before accepting this answer.
Find out the name of the object's superclass (or one of the superclasses, since Perl has multiple inheritance), and define the save call in the superclass's package.
For example, if you have
package MyClass;
use YourClass;
our #ISA = qw(YourClass); # <-- name of superclass
...
sub foo {
my $self = shift;
...
$self->SUPER::save(); # <--- want to mock this function in the test
...
}
sub save {
# MyClass version of save method
...
}
then in your test script, you would say
no warnings 'redefine'; # optional, suppresses warning
sub YourClass::save {
# mock function for $yourClassObj->save, but also
# a mock function for $myClassObj->SUPER::save
...
}