Imagine this subroutine:
sub test(&&)
{
my $cr1 = shift;
my $cr2 = shift;
$cr1->();
$cr2->();
}
I know I can call it like: test(\&sub1,\&sub2), but how can I call it like:
test { print 1 },{ print 2 };
If I say that the subroutine takes only one &, than sending a block will work. I don't know how to make it work with 2.
If I try to run it like that, I get:
Not enough arguments for main::test at script.pl line 38, near "},"
EDIT: is there no way of invoking without sub?
You need to explicitly say
test( sub { print 1 }, sub { print 2 } );
or
test { print 1 } sub { print 2 };
The implicit "sub" is only available for the first argument. http://perldoc.perl.org/perlsub.html#Prototypes:
An & requires an anonymous subroutine, which, if passed as the first argument, does not require the sub keyword or a subsequent comma.
Some things use an extra word in there to fake it:
test { print 1 } against { print 2 };
sub against (&) { $_[0] }
sub test (&#) { ... }
but I've never liked that much.
You can do this:
test(sub { print 1 }, sub { print 2 });
I've got the following code in one of my programs:
sub generate($$$$)
{
my ($paramRef, $waypointCodeRef, $headerRef,
$debugCodeRef) = #_;
...
&$headerRef();
...
my $used = &$waypointCodeRef(\%record);
And I call it with
CreateDB::generate(\%param, \&wayPointCode, \&doHeader, \&debugCode);
If you really want to bend the syntax more then take look at Devel::Declare
Examples of modules that use Devel::Declare:
MooseX::Declare (GitHub repo)
Test::Class::Sugar (GitHub repo)
PerlX::MethodCallWithBlock (GitHub repo)
Full list of modules on CPAN dependant on Devel::Declare can be found via CPANTS
Here is example from Test::Class::Sugar pod:
use Test::Class::Sugar;
testclass exercises Person {
# Test::Most has been magically included
startup >> 1 {
use_ok $test->subject;
}
test autonaming {
is ref($test), 'Test::Person';
}
test the naming of parts {
is $test->current_method, 'test_the_naming_of_parts';
}
test multiple assertions >> 2 {
is ref($test), 'Test::Person';
is $test->current_method, 'test_multiple_assertions';
}
}
Test::Class->runtests;
And here is something sexy from PerlX::MethodCallWithBlock pod:
use PerlX::MethodCallWithBlock;
Foo->bar(1, 2, 3) {
say "and a block";
};
Devel::Declare is a much more robust and saner way of contorting your Perl code compared to using a source filter like Filter::Simple.
Here is a video from its author which may help a bit more.
/I3az/
Related
I want to write a function whose first parameter is a description, and the second parameter is a code block. I want the finished code to read like:
verify "description" { boolean-assertion-block };
I'm specifically looking to avoid the sub keyword.
I can put the description AFTER the code block, no problem:
sub verify (&$) { ... }
But when I reverse the prototype symbol order:
sub verify ($&) { ... }
Then I get an error message:
Type of arg 2 to main::verify must be sub {} (not anonymous hash ({})) at ...
Clearly, Perl has special handling for the first argument being a code block.
So, maybe I can make it a curried function?
sub verify ($) {
my $message = shift;
return sub (&) { . . . }
}
But then I get a syntax error between the description and the code block:
syntax error at ... near ""..." { "
I tried altering the calling syntax to try to help out the compiler:
test "...", { BLOCK };
test("..."){ BLOCK };
test("...")({ BLOCK });
( test "..." )({ BLOCK });
No joy. Can Perl even do what I want to do?
The (&) prototype only has such niceness when used for the first argument in a sub. From perldoc perlsub:
The interesting thing about "&" is that you can generate new syntax with it, provided it's in the initial position
One way to provide a similar level of niceness would be:
sub verify ($%) {
my ( $message, %opts ) = #_;
my $coderef = $opts{using};
...;
}
sub using (&) {
my ( $coderef ) = #_;
return ( using => $coderef );
}
# The `verify` sub accepts a name followed by a hash of options:
#
verify(
"your message here",
"using" => sub { ... },
);
# The `using` sub returns a two-element list that will satisfy
# that hash of options:
#
verify "your message here", using {
...;
};
If you desperately want to allow a syntax exactly like:
verify "description" { boolean-assertion-block };
... then it is still possible, but requires the dark arts. Keyword::Simple is probably your best bet, but Devel::Declare and Filter::Simple are options.
You can only use the block syntax if the & is the first thing in your prototype. From perlsub:
An & requires an anonymous subroutine, which, if passed as the first argument, does not require the sub keyword or a subsequent comma
Other custom DSL such as in Dancer2 or Mojolicious typically use the sub keyword.
get '/foo' => sub {
...
};
Plack::Builder and Web::Scraper use blocks that return objects, which then can be nested.
I have one script (A.pl) and one package (B.pm), I want to create a static variable in B.pm so that it can accessible to A.pl.
A.pl
use lib 'path/to/B_Package';
for loop 10 times {
fun(age);
}
if ($count>0) {
print "script fails";
}
B.pm
package B {
fun() {
my $age_given = shift;
my $count;
eval {
result = someFileHandling;
} or die {
$count++;
}
}
}
I'd question such design, and some alternatives are offered below.
But yes it can be done -- a variable declared as our can be accessed by its fully qualified name.
In the package file Pack.pm
package Pack;
use warnings;
use strict;
use Exporter qw(import);
our #EXPORT_OK = qw(func);
our $count = 7;
sub func { ++$count }
1;
and in its user
use warnings;
use strict;
use feature 'say';
use Pack qw(func);
for (1..2) {
func();
say "Current value of a global in 'Pack': ", $Pack::count;
}
$Pack::count = 123;
say "Current value of a global in 'Pack': ", $Pack::count;
So changes to $count made in Pack::func() are seen in the calling program. More to the point, $Pack::count can be directly written by any code in the interpreter.
The package globals that are meant to be used directly, like $count above,† are tricky creatures that can be hard to use sensibly but are very easy to end up abusing.
In general you don't want them: their use runs contrary to the critical idea of dividing software in components that communicate via clearly defined interface, they introduce uncontrolled coupling and thus defeat scope, etc. With such variables in use distinct components in the code get entangled.
But they can of course be useful and are used in libraries, mostly for constants and parameters.
Now, having them change as well? That can get out of control, and even though that, too, is used in libraries (to control their behavior by setting parameters) it veers closer to an analogue of a "God Class," an all-controlling entity. At that point I would flatly call it flawed and a trouble-maker.
Why not have subs handle the counting and return updated values? They can keep values using state pragma for instance. Or even using a file-scoped variable, as long as that is internal to its business and outsiders aren't allowed to poke at it.
Here's a sample for the two mentioned approaches in revised Pack.pm
package Pack;
use warnings;
use strict;
use feature qw(state);
use Exporter qw(import);
our #EXPORT_OK = qw(count func1 func2);
my $count = 7;
sub func1 { ++$count } # sets counter while doing its other work
sub count { # add check that input is numeric
$count += shift for #_; # Set count if values passed,
return $count; # return value in either case
}
sub func2 {
state $count = 0; # keeps count (its own $count)
return $count += shift // 1; # demo: add some and return
}
1;
Demo for its use:
use warnings;
use strict;
use feature 'say';
use Pack qw(count func1 func2);
say "Call func2(), using 'state' feature, with its own counter: ";
for (1..2) { say "func2($_): ", func2($_) }
say '';
say "Set value for a file-wide counter, retrieve using count(): ";
for (1..2) { func1() }
say "Count is: ", count();
say "Use count() to set values as well: ";
for (1..2) { say "For #$_: ", count($_) }
This prints
Call func2(), using 'state' feature, with its own counter:
func2(1): 1
func2(2): 3
Set value for a file-wide counter, retrieve using count():
Count is: 9
Use count() to set values as well:
With 1: 10
With 2: 12
The next step up is to make this a class, and then you can implement any and all kinds of counters in very natural ways.
For more on variables, see this post and this post and this Effective Perler article, for starters.
† An our variable is strictly speaking not a global, but a lexical that is aliased to a package variable (a "true" global) with the same name.
I think there's a better way to do what I'm guessing that you want to do. I think that you want to try something a certain number of times and give up if you can't acheive that goal.
When you call your subroutine, you want it to know how many times to try. Also, you want to know when it fails.
You don't need to share a variable for this. The die is going to take care of that for you. Call the sub as many times as you like, and each time you don't get back a value from eval, count that as an error:
my $errors = 0;
foreach ( 1 .. 10 ) {
my $result = eval { do_this($age) };
$errors++ unless defined $result;
}
print "Script fails" if $errors > 0;
In the subroutine, you don't need to worry about how many times this has been done because that's happening at the higher level for you. You look at the result of the subroutine to decide if it failed and adjust a counter at the higher level. Now the subroutine can focus on it's small part instead of thinking about why you are calling it. You also don't need the eval at this level because you already have it at the higher level.
sub do_this {
my( $age ) = #_;
... some file handling ...
}
Factories
But let's say that there is some good reason for a lower subroutine to know its count. I don't want to pollute that subroutine for everyone—suppose that 10 other places in the program also call this subroutine and they all fail. Should that count against your call? You probably don't want that. But, there's a way around this. You can create a new version of the subroutine when you need to. A factory is a subroutine that makes other subroutines.
Let's say you want to try something a certain number of times. But, you might want to do that multiple times too. Make a new subroutine every time that you want to try this. Tell that subroutine how many tries it gets:
sub some_factory {
my( $max_tries ) = #_;
sub anon_thingy {
my( $age ) = #_;
for ( 1 .. $max_tries ) {
... file handling ... or die ...
}
}
}
Your program would then look something like:
my $try_this = some_factory( 10 );
my $result = eval { $try_this->($age) };
print "Script fails" unless defined $result;
In the same program, you can do it again, and each generated code reference tracks its own use and doesn't bother other subs:
foreach $age ( list_of_ages() ) {
my $new_sub = some_factory( 10 );
my $result = eval { $new_sub->($age) };
print "Script fails" unless defined $result;
}
I spend quite a bit of time on this sort of stuff in Intermediate Perl and Mastering Perl.
I am working on a program which makes multiple attempts at processing, storing to a new log each time it tries (several other steps before/after).
use strict;
for (my $i = 0; $i < 3; $i++)
{
my $loggerObject = new MyLoggerObject(tag => $i);
#.. do a bunch of other things ..
Process($loggerObject,$i);
#.. do a bunch of other things ..
}
sub Process
{
my ($logger,$thingToLog) = #_;
sub Logger { $logger->Print($_[0]); }
Logger("Processing $thingToLog");
}
package MyLoggerObject;
sub new
{
my $package = shift;
my %hash = (#_); my $self = \%hash;
return bless $self, $package;
}
sub Print
{
my $self = shift;
my $value = shift;
print "Entering into log ".$self->{tag}.": $value\n";
}
1;
To avoid having to do a bunch of $self->{logger}->Print() and risk misspelling Print, I tried to collapse them into the local subroutine as seen above. However, when I run this I get:
perl PerlLocalMethod.pl
Entering into log 0: Processing 0
Entering into log 0: Processing 1
Entering into log 0: Processing 2
instead of:
perl PerlLocalMethod.pl
Entering into log 0: Processing 0
Entering into log 1: Processing 1
Entering into log 1: Processing 2
I am presuming the problem is that the Logger method is 'compiled' the first time I call the Process method with the object reference I used on the first call but not afterwards.
If I did $logger->Print(), misspelling Print, and hit a codepath I can't reliably test (this is for an embedded system and I can't force every error condition) it would error out the script with an undefined Method. I suppose I could use AUTOLOAD within logger and log any bad Method calls, but I'd like to know any other recommendations on how to make sure my Logger() calls are reliable and using the correct object.
In Perl, subroutines are compiled during compile time. Embedding a named subroutine declaration into a subroutine doesn't do what one would expect and isn't recommended.
If you are afraid of typos, write tests. See Test::More on how to do it. Use mocking if you can't instantiate system specific classes on a dev machine. Or use shorter names, like P.
You can declare the Logger in the highest scope as a closure over $logger that you would need to declare there, too:
my $logger;
sub Logger { $logger->Print($_[0]) }
But it's confusing and can lead to code harder to maintain if there are many variables and subroutines like that.
If you had used use warnings in your code you would have seen the message:
Variable "$logger" will not stay shared at logger line 24.
Which would have alerted you to the problem (moral: always use strict and use warnings).
I'm not entirely sure why you need so many levels of subroutines in order to do your logging, but it seems to me that all of your subroutines which take the $logger object as their first parameter should probably by methods on the MyLoggerObject (which should probably be called MyLoggerClass as it's a class, not an object).
If you do that, then you end up with this code (which seems to do what you want):
use strict;
use warnings;
for my $i (0 .. 2) {
my $loggerObject = MyLoggerClass->new(tag => $i);
#.. do a bunch of other things ..
$loggerObject->Process($i);
#.. do a bunch of other things ..
}
package MyLoggerClass;
sub new {
my $package = shift;
my $self = { #_ };
return bless $self, $package;
}
sub Process {
my $self = shift;
my ($thingToLog) = #_;
$self->Logger("Processing $thingToLog");
}
sub Logger {
my $self = shift;
$self->Print($_[0]);
}
sub Print {
my $self = shift;
my ($value) = #_;
print "Entering into log $self->{tag}: $value\n";
}
1;
Oh, and notice that I moved away from the indirect object notation call (new Class(...)) to the slightly safer Class->new(...). The style you used will work in the vast majority of cases, but when it doesn't you'll waste days trying to fix the problem.
As already explained above, using lexical defined variables in these kinds of method is not possible.
If you have to "duct-tape" this problem you could use global Variables (our instead of my).
sub Process
{
our ($logger,$thingToLog) = #_;
sub Logger { $logger->Print($_[0]); }
Logger("Processing $thingToLog");
}
But be aware that $logger and $thingToLog are now global variables accessible outside this function.
I have 4 sub rountines (sub room1 {do stuuf...}, sub room2{do stuff...}, sub room3{do other stuff...}) that will each do different things inside the routine.
What I want to do is to be able to dynamically call a routine based on a variable name.
For exmaple,
if ($currentRoom == 1) { &room1; }
if ($currentRoom == 2) { &room2; }
if ($currentRoom == 3) { &room3; }
What I would rather do, is just call the correct sub routine using $currentRoom as the value after &room. Something like &room{$currentRoom};
Can this be done and if so, how can I achieve this.
Create a hash relating room numbers to subroutine references:
my %room_actions = (
1 => \&room1,
2 => \&room2,
3 => \&room3,
);
if ($room_actions{$currentRoom}) {
$room_actions{$currentRoom}->();
} else {
die "room doesn't exist: $currentRoom";
}
You could try this:
use strict;
use warnings;
sub test1 {print 1}
sub test2 {print 2}
my $test = 1;
{ # naked block, to make no strict 'refs' not global
no strict 'refs';
&{'test'.$test}();
}
Output:
1
but be prepared, if you try to access a sub (e.g. 3 at code above), which does not exists, you will get a warning:
Undefined subroutine &main::test3 called at test.pl .....
This is almost 2 years late, but I landed here after a somehow related search and I was struck by the lack of this solution:
__PACKAGE__->can('room' . $currentRoom)->();
You can also add some custom error checking:
if (my $sub = __PACKAGE__->can('room' . $currentRoom)) {
$sub->();
}
This is a kind of quick and dirty dispatch table, using can instead of a hash access but without giving up any safenets.
I'm a bit messed up with the following:
I have a function that calls subroutines in the following way:
sub someFunction {
my $self = shift;
my $type = $self->{'type'};
if($type eq 'one_subroutine') {
$self->updateOneSubroutine();
}
elsif($type eq 'another_one_sub') {
$self->updateAnotherOneSub();
}
(...)
else {
die "Unsupported '$type'";
}
I have to change this to let each subroutine be coded in its own file, include all available files, and automagically call the subroutine inside.
I did this in a test file with the following code:
# Assume a routines subdir with one_subroutine.pm file with
sub updateOneSubroutine(){
$self = shift;
$self->doSomeThings();
(...) #my code
}
1;
test.pl
# Saves in routines hash_ref a pair of file_name => subRoutineName for each file in routines subdir.
# This will be used later to call subroutine.
opendir(DIR,"lib/routines") or die "routines directory not found";
for my $filename (readdir(DIR)) {
if($filename=~m/\.pm$/){
# includes file
require "lib/routines/$filename";
# get rid of file extension
$filename=~s/(.*)\.pm/$1/g;
my $subroutine = "update_${file}";
# camelizes the subroutine name
$subroutine=~s/_([a-z0-9])/\u$1/g;
$routine->{ $filename } = $subroutine;
}
}
{
no strict "refs";
$routine->{$param}();
}
where param is something like "one_subroutine", that matches with a filename available.
Since each subroutine receives $self in the call, I should call the routine by $self->something();
I've tried $self->$routine->{$param}() , $self->${routine->${param}}() and many other things without success. I've checked chapter 9 "dynamic subroutines" of mastering perl, and a similar question to perl monks, but I can't still figure out how to reference the subroutine in a way that represents $self->updateAnotherOneSub() , or something similar that lets $self be read as a param in those subroutines.
Thanks in advance, Keber.
This seems a bit like an X/Y problem. What exactly are you trying to do? If it is to reduce loading time, then modules like AutoSplit/AutoLoader might be of interest to you.
If it is to create some sort of data structure of subroutines, you should be installing anonymous subs into a hash, rather than giving them all names.
Given a subroutine reference:
my $code = sub {...};
you would call it as:
$self->$code(...);
If instead you have a subroutine name, you can lookup the coderef:
my $code = 'Package::With::The::Subroutines'->can('method_name');
and if that succeeds (check it), then you can use $self->$code(...) to call it.
Given this code:
{
no strict "refs";
$routine->{$param}();
}
You would pass $self to the routine with:
{
no strict "refs";
$routine->{$param}($self);
}
Or you could approach it the way I did above with can:
'package'->can($routine->{$param})->($self)
if you don't want to turn off strict 'refs'
Try to extract the method name first, then it should work. I did a small test script that may do something like you want to, so:
my $method = $routine->{$param};
$self->$method->();
You can and of course should check, if the desired method exists like Eric said:
if ($self->can($method)) {
$self->$method->();
}
The important part here is, that you extract the method name so you have it in a single variable; otherwise perl won't figure that out for you - and as far as I know there is no way of setting parens or braces to do so.