Perl: cmpthese text vs anonymous sub problems with parameters passed - perl

If you read about cmpthese in the Perl Benchmark module's documentation, it states that cmpthese or timethese can be used with code in either text or subroutine references. The documentation seems to imply these forms are completely interchangeable:
# Use Perl code in strings...
timethese($count, {
'Name1' => '...code1...',
'Name2' => '...code2...',
});
# ... or use subroutine references.
timethese($count, {
'Name1' => sub { ...code1... },
'Name2' => sub { ...code2... },
});
I am having difficulties with passed parameters with the string form versus subroutine references form with cmpthese. Either the values in #array do not get passed or I have a run-time error.
I have the following code:
#!/usr/bin/perl
use strict; use warnings;
use Benchmark qw(:all);
my #array = qw( first second third );
sub target {
my $str = $_[0];
print "str=$str\n";
}
sub control {
print "control: array[0]=$array[0]\n";
}
my $sub_ref=\⌖
my $control_ref=\&control;
print "\n\n\n";
# ERROR: array does not get passed...
cmpthese(1, {
'target text' => 'target(#array)',
'control 1' => 'control()',
});
# This is OK...
cmpthese(1, {
'sub code ref' => sub { target(#array) },
'control 2' => sub { control() },
});
# This is OK too...
cmpthese(1, {
'target sub' => sub { $sub_ref->(#array) },
'control 3' => sub { $control_ref->() },
});
# fixed paramenters work:
cmpthese(1, {
'target text fixed' => 'target("one", "two", "three")',
'control 4' => 'control()',
});
# Run time error...
cmpthese(1, {
'text code ref' => '$sub_ref->(#array)',
'control 5' => '$control_ref->()',
});
All the forms I have work correctly with eval so I think this may be an issue with Benchmark? I have used all my google foo to try and find some documented difference between the two forms but I cannot.
Does anyone know the reason that my simple examples above do not seem to work as expected? The comments in the code indicate the problems I am having on OS X, Perl 5.10.0.

The text passed to cmpthese and timethese gets propogated to an eval statement deep in the bowels of Benchmark. Unless the arguments in the text are literals or global variables, they won't be in scope by the time they are evaluated, and you get a run-time error.
Use the anonymous sub version of the arguments to provide lexical closure for your arguments and all will be well.

I haven't looked in too much detail at this, but my guess is that when Benchmark evals the strings into code, the lexical variable #array is not in scope. Things would probably work if you made #array an our variable.
But in general, I find it is easier just to use code refs.

Related

How Mojolicious modifies Perl syntax

Reading Mojolicious minions documentation I found the following code:
use v5.28;
use Mojolicious::Lite;
use experimental qw( signatures );
use Time::HiRes qw( time );
plugin Minion => {
SQLite => 'sqlite:' . app->home->child('minion.db'),
};
# ...
app->start;
How did they create a new syntax plugin Minion => {...}? I've never seen it in classic Perl books. Is it a function call with a hash parameter: "Minion" being a key and a hashref {...} is a value?
Also they call app->start - app is a function returning a blessed hashref? But if it was a hash why "start" is not enclosed into braces? This syntax looks strange to me.
app is a function which returns $app which is an instance of Mojolicious::Lite=HASH
app->start is same as app()->start
https://github.com/mojolicious/mojo/blob/24d1d1987dbfbe27eaaa37dd5db692d2deb8d07f/lib/Mojolicious/Plugin/Config.pm#L12-L14
"sub app; local *app = sub { \$app }; use Mojo::Base -strict; $content";
|
^ not a reference but escape
due to eval() of double quoted string
Reproduction
perl -MMojolicious::Lite -E 'no warnings; sub foo; local *foo = sub { app }; say for foo, app'
output
Mojolicious::Lite=HASH(0xe72080)
Mojolicious::Lite=HASH(0xe72080)
plugin is a regular function
perl -MData::Dumper -wE 'sub plugin { print Dumper \#_ } plugin Minion => { SQLite => "sqlite:" }'
$VAR1 = [
'Minion',
{
'SQLite' => 'sqlite:'
}
];
You can add parens, and drop fat comma to look like the usual function call,
plugin("Minion", { SQLite => "sqlite:" });

Why "Type of argument to each on reference must be unblessed hashref or arrayref at test.pl line 17."?

I don't understand the error message
Type of argument to each on reference must be unblessed hashref or arrayref at test.pl line 17.
for this test case (extracted from a larger module):
BEGIN { our $RE_timestamp = qr/whatever/; }
# check Regular expressions for TIMESTAMP
use constant _TEST_TIMESTAMPS => ( # from "6.2.3.1. Examples"
'1985-04-12T23:20:50.52Z' => 1,
'1985-04-12T19:20:50.52-04:00' => 1,
'2003-10-11T22:14:15.003Z' => 1,
'2003-08-24T05:14:15.000003-07:00' => 1,
'2003-08-24T05:14:15.000000003-07:00' => 0, # invalid!
'-' => 1 # NILVALUE
);
UNITCHECK
{
# from "6.2.3.1. Examples"
while (my ($str, $valid) = each _TEST_TIMESTAMPS) {
if ($valid) {
die "timestamp ($str) is not valid\n"
if ($str !~ /^${RE_timestamp}$/o);
} else {
die "timestamp ($str) is valid\n"
if ($str =~ /^${RE_timestamp}$/o);
}
}
}
Most of all I got the error in Perl 5.18.2, but when I checked on another machine using Perl 5.26.1, there was no error message at all!
So can I make the code work with the older Perl 5.18, too?
Ugly Work-Around
Experimenting I found out that each (my %h = _TEST_TIMESTAMPS) did not help, but when using my %h = _TEST_TIMESTAMPS; and then each %h, then the error was gone.
Still I don't understand what's going on (before using constants I had local my hashes used inside UNITCHECK.
Obviously I'd like to use package-level constants instead.
That _TEST_TIMESTAMPS is given as a "list constant" in the question and will behave only as a flat list, not as a hash. See this post for a very detailed discussion. Also, as such it is rejected by each as the error message informs us.
One can use a hash-reference instead
use constant _TEST_TIMESTAMPS => { ... };
and this is accepted by each. It appears to work correctly for the question's snippet but I'd be careful with more involved use. Using references with constant comes with its own issues.
Also, keep in mind that objects from constant pragma are really subroutines ("in the current implementation", as docs say); see Technical Note and Bugs. This can affect what one should expect of their behavior in various circumstances.
One the other hand, swapping const for, say, Const::Fast, makes it work cleanly under all circumstances with normal lexical variables
use warnings;
use strict;
use feature 'say';
use Const::Fast;
our $RE_timestamp;
BEGIN { our $RE_timestamp = qr/whatever/; }
# check Regular expressions for TIMESTAMP
our %_TEST_TIMESTAMPS;
BEGIN {
const our %_TEST_TIMESTAMPS => ( # from "6.2.3.1. Examples"
'1985-04-12T23:20:50.52Z' => 1,
'1985-04-12T19:20:50.52-04:00' => 1,
'2003-10-11T22:14:15.003Z' => 1,
'2003-08-24T05:14:15.000003-07:00' => 1,
'2003-08-24T05:14:15.000000003-07:00' => 0, # invalid!
'-' => 1 # NILVALUE
);
}
UNITCHECK
{
# from "6.2.3.1. Examples"
while (my ($str, $valid) = each %_TEST_TIMESTAMPS) {
if ($valid) {
die "timestamp ($str) is not valid\n"
if ($str !~ /^${RE_timestamp}$/o);
} else {
die "timestamp ($str) is valid\n"
if ($str =~ /^${RE_timestamp}$/o);
}
}
}
Lexicals introduced with Const::Fast must be assigned at declaration (and of course cannot be reassigned later), so here that has to be an our variable as it need be assigned inside of a BEGIN block but declared outside of it, so to be set and visible for UNITCHECK.†
I use Const::Fast merely as my preference; another viable library is Readonly.
Note that $RE_timestamp must be first lexically declared outside of any blocks if strict is to be used (and why wouldn't one use it?). I corrected that. It need not be our for any of this but I leave that since there may be other reasons for it.
As for why this isn't an issue in later Perls, I suppose that the requirement for it to be a hashref or arrayref got dropped at some point. (I can't check that right now.)
† That we can formally declare a variable at multiple places is a property of the lexical alias of a global variable, our.
The problem seems to be each insisting on a hash variable (not a constant), so I solved it like this (not genuine, but it works):
UNITCHECK
{
my $hr = { _TEST_TIMESTAMPS };
while (my ($str, $valid) = each %$hr) {
#...
}
}
However a new temporary hash will be created by { _TEST_TIMESTAMPS }, so it might be better to assign a hash reference to the constant instead.
Then you'd still need a variable, but no temporary hash object would be created.

unit test for Perl's sort

I try to use a (class) method in an Object for sorting object instances.
package Something;
use strict;
use warnings;
use Data::Dumper;
sub new {
my ($class, $date) = #_;
my $self = bless{}, $class;
$self->{date} = $date;
return $self;
}
sub _sort($$) {
print STDERR Dumper($_[0], $_[1]);
$_[0]->{date} cmp $_[1]->{date};
}
package SomethingTest;
use base 'Test::Class';
use Test::More;
__PACKAGE__->runtests() unless caller;
sub sorting : Test {
my $jan = Something->new("2016-01-01");
my $feb = Something->new("2016-02-01");
my $mar = Something->new("2016-03-01");
is_deeply(
sort Something::_sort [$feb, $mar, $jan],
[$jan, $feb, $mar]);
}
I've seen this snippet in perldoc -f sort, hence the prototype for _sort.
# using a prototype allows you to use any comparison subroutine
# as a sort subroutine (including other package's subroutines)
package other;
sub backwards ($$) { $_[1] cmp $_[0]; } # $a and $b are
# not set here
package main;
#new = sort other::backwards #old;
However, the dumped arguments look odd:
$VAR1 = [
bless( {
'date' => '2016-02-01'
}, 'Something' ),
bless( {
'date' => '2016-03-01'
}, 'Something' ),
bless( {
'date' => '2016-01-01'
}, 'Something' )
];
$VAR2 = [
$VAR1->[2],
$VAR1->[0],
$VAR1->[1]
];
and the test fails with
# Failed test 'sorting died (Not a HASH reference at sort.t line 16.)'
# at sort.t line 25.
Is this just my test setup or can't I have the same objects in these arrays?
What else am I missing?
Your problem isn't with the subroutine you pass to sort(), but in the arguments you pass to is_deeply(). The way you have written it parses like this, if we add some parentheses:
is_deeply(
sort(Something::_sort [$feb, $mar, $jan], [$jan, $feb, $mar] )
);
That is, you're telling sort() to act on a list consisting of two anonymous array references, and then is_deeply() to run with the single argument returned from sort (except it crashes before is_deeply() can try to run and complain that you gave it too few arguments to work with).
This is probably closer to what you intended:
is_deeply(
[sort(Something::_sort ($feb, $mar, $jan))],
[$jan, $feb, $mar]);
That is, tell is_deeply() to compare two anonymous arrays, the first of which is made from telling sort() to apply your sorting routine to the list ($feb, $mar, $jan).

I am trying to create a template for placeholders for Error messages in perl. Any suggestions?

I have a solution for this currently but it may not be the most versatile code. I know there is a way to use templates with placeholders for variables instead of putting the actual runtime parameters into the error message. Apologies if what I'm asking is unclear. I don't have a whole lot of knowledge on how to use templates.
use constant {
#list will contain more errors
ERROR_SW => {
errorCode => 727,
message => sub{"Not able to ping switch $switch_ip in $timeout seconds"},
fatal => 1,
web_page => 'http://www.errorsolution.com/727',
}
};
sub error_post {
my ($error) = #_;
print($error->{message}());
}
error_post(ERROR_SW);
I am trying to design it so that I can use placeholders for $switch_ip and $timeout instead of having to declare the message as a subroutine reference.
Like below
use constant {
#list will contain more errors
ERROR_SW => {
errorCode => 727,
message => "Not able to ping switch **{{switch_ip}}** in **{{timeout}}** seconds",
fatal => 1,
web_page => 'http://www.errorsolution.com/727',
}
};
sub error_post {
my ($error) = #_;
print($error->{message});
}
error_post(ERROR_SW);
They also appear in code like so:
%%error%%
I'm not sure how to create the template which will handle the parameters.
Again Apologies for being vague or not explaining this well.
I can't immediately see what this approach buys you that isn't provided by the printf format I explained before, but
I suggest you use the Text::Template module to do it this way. It is less extensive than Template::Toolkit but perfectly adequate for your purposes
Here's what a program using Text::Template would look like. I hope it helps you
use strict;
use warnings 'all';
use Text::Template qw/ fill_in_string /;
use constant {
ERROR_SW => {
errorCode => 727,
message => 'Not able to ping switch {$switch_ip} in {$timeout} seconds',
fatal => 1,
web_page => 'http://www.errorsolution.com/727',
}
};
my $values = {
switch_ip => '192.168.0.1',
timeout => 60,
};
sub error_post {
my ($error) = #_;
print( fill_in_string($error->{message}, hash => $values) );
}
error_post(ERROR_SW);
output
Not able to ping switch 192.168.0.1 in 60 seconds
I would create a package for each error type in you project. Each error object should have the necessary attributes to describe the error and a as_string() method giving a human readable message.
These packages can be written using you normal Object oriented framework (e.g. Moose). With good old perl objects it could look like this:
package My::Error;
sub new {
my ($class, %self) = #_;
bless \%self, $class;
}
package My::Error::SW;
use parent 'My::Error';
sub as_string {
my $self = shift;
return sprintf "Not able to ping switch %s in %s seconds", $self->{switch_ip}, $self->{timeout};
}
There exists multiple frameworks for this on CPAN. One example is the Throwable modules which uses Moose.

How to check undefined key in perl OO code?

I have use strict;use warnings; in my perl script;
But this error cannot be found:
sub new {
#....
my $self={};
$self->{databas}="..."; # 'e' is missing
#....
}
sub foo {
my $self=shift;
print $self->{database}; # undef
}
I have spend hours to found out that database in mispelled in sub new.
use strict;use warnings; didnt help.
How can I avoid this error?
Restrict/lock hashes with Hash::Util.
Alternatively, use Moose to describe your classes, making a misspelled attribute a run-time error.
package MyClass;
use Moose;
has 'database' => (isa => 'Str', is => 'rw', default => 'quux');
sub foo {
my ($self) = #_;
$self->database; # returns quux
$self->databas; # Can't locate object method "databas" via package…
use defined, or // operator (if you have perl 5.10/later)
print "not defined" if !defined $a; # check if $a is undef
print $a // 'undefed!'; # print a if availiable, "undefed!" otherwise
See http://perldoc.perl.org/functions/defined.html and http://perldoc.perl.org/perlop.html#C-style-Logical-Defined-Or
Use getters and setters instead of hash keys, or switch to Moose.
Do you think you would have spotted it if you saw the hash dumped out? Like this:
$self = bless( {
'anotherfield' => 'something else',
'databas' => '...',
'afield' => 'something'
}, 'MyClass' );
If you were wondering "How come 'database' isn't set?!?!" and you dumped this out, do you think that would help? "Oh it assigned 'databas' not 'database'!"
Then Data::Dumper is the minimal Perl debugging tool
use Data::Dumper;
...
# Why isn't database assigned?!?!
say Data::Dumper->Dump( [ $self ], [ '$self' ] );
Of course, the most convenient form of Data::Dumper tools is Smart:Comments.
use Smart::Comments;
...
### $self
Which outputs:
### $self: bless( {
### afield => 'something',
### anotherfield => 'something else',
### databas => '...'
### }, 'MyClass' )
It's not as preventative a tool as Moose but it will save hours, though. I think it even helps you learn Perl tricks and practices as you spill out the guts of CPAN objects. When you know the underlying structure, you have something to search for in CPAN modules.
Like I said, it solves the problem of hours tracking down bugs (often enough).
Another approach is to use the core module Class::Struct.
package MyObj;
use Class::Struct;
struct(
databas => '$',
# ...
);
1;
package main;
# create object
my $obj = MyObj->new(databas => 'MyDB');
# later
print $obj->database;
Running this results in the following error:
Can't locate object method "database" via package "MyObj" at ... .