How Mojolicious modifies Perl syntax - perl

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:" });

Related

Call from a code reference in Template Toolkit

I have a simple higher-order function that builds a message formatter.
use strict;
use warnings;
sub make_formatter {
my $level = shift;
return sub {
my $message = shift;
return "[$level] $message";
}
}
I use it from Perl like that:
my $component_formatter = make_formatter('ComponentError');
print $component_formatter->('Hello') . "\n";
I want to use make_formatter from a Template Toolkit template. I have tried to do the following:
use Template;
use Template::Constants;
my $template = Template->new({
# DEBUG => Template::Constants::DEBUG_ALL,
VARIABLES => {
make_formatter => make_formatter,
}
});
my $template_str = "
[% my_formatter = make_formatter('MyFormatter') %]
<h1>[% my_formatter('Sample message') %]</h1>
";
$template->process(\$template_str);
The output of this script is:
$ perl test.pl
Use of uninitialized value $level in concatenation (.) or string at test.pl line 10.
<h1>[] MyFormatter</h1>
Is it possible to call my_formatter using only Template Toolkit syntax ? Calling external Perl code that is not callable by default from Template Toolkit is not an option.
First let me please point out that putting use strict; use warnings; at the beginning of your script is strongly advised.
If you do that for your snippet generating the $template,
you will get a Bareword "make_formatter" not allowed while "strict subs" in use error, which should help you determine this is not a useful notation.
Now if you call make_formatter() instead, this will output <h1>[] MyFormatter</h1>. This makes sense: your function returned the sub, which is called with 'MyFormatter' in your template ( and $level is undef, as you called make_formatter with no input ).
As Mr. Haegland pointed out,
my $template = Template->new({
VARIABLES => {
make_formatter => \&make_formatter,
}
});
leads to the output I understand you want:
<h1>[MyFormatter] Sample message</h1>
\&make_formatter gives you a subroutine reference,
which in perl normally you could call using:
my $ref = \&make_formatter; $ref->( 'Input' );
This can then be called in the first line of your template,
returning another code ref, which is then called in your second line.
Hope this helps!

Strange behavior of a tied hash in perl, when asking for an arrayref

I was trying to tie an hash (or hashref) in order of tracking variable usages.
Everything is working for simple cases, but when I tried to use my module on some real code I had this error:
hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)
I've replicated the error using the following code:
use Tie::Hash::Usages;
use JSON;
my #arr = (
{
key1 => "ac",
key2 => 12,
key3 => 12
},
);
my %tied_hash;
tie %tied_hash, 'Tie::Hash::Usages';
$tied_hash{key1} = \#arr;
my #val = $tied_hash{key1};
print encode_json(\#val)."\n\n"; #this works
print encode_json($tied_hash{key1}); #this doesn't
The same code works with a plain hash.
I'd need this to work also in the second case, the code base is huge and I don't want to change it or live with the doubt that something somewhere will not work in some particular case.
Usages.pm (simplified)
package Tie::Hash::Usages;
use strict;
use warnings;
use Tie::Hash;
use vars qw(#ISA);
#ISA = qw(Tie::StdHash);
sub TIEHASH {
my ($class, $tracker, $filename) = #_;
my %hash;
bless \%hash, $class;
}
sub STORE {
my ($self, $key, $val) = #_;
$self->{$key} = $val;
}
sub DELETE {
my ($self, $key) = #_;
delete $self->{$key};
}
sub FETCH {
my ($self, $key) = #_;
return $self->{$key};
}
sub DESTROY {
my $self = shift;
}
1;
perl version: v5.18.2
Minimal demonstration:
use JSON::XS qw( encode_json );
use Tie::Hash qw( );
our #ISA = 'Tie::StdHash';
{
tie my %tied, __PACKAGE__;
$tied{data} = { a => 1 };
encode_json($tied{data}); # Exception: hash- or arrayref expected ...
}
JSON is a front-end for JSON::PP (default) or JSON::XS (if found). This is a problem with JSON::XS.
A lot of XS code doesn't handle magical variables (which is what $tied{EXPR} returns), and while JSON::XS has handled magical values since version 1.2, it doesn't for the value directly passed to encode_json.
This is an existing bug in JSON::XS that can be worked around as follows:
encode_json(my $non_magical = $tied{data})
Bug reported.
Unable to replicate using the code given, so what you're providing doesn't seem to be representative of your actual situation. The only thing I see that's the tiniest bit off is this line:
my #val = $tied_hash{key1};
in which you're assigning a scalar (your stored arrayref) to an array. Perl handles this fine, assembling an array with the scalar as sole content, but if your actual use case involves something more complex (maybe something with sub prototypes involved), conceivably something might be going wrong there.
Ether got it right. JSON library uses JSON:XS by default (which creates this issue). All I had to do is uninstall JSON::XS and install JSON::PP
sudo cpan
install cpan App::cpanminus
exit
sudo cpanm --uninstall JSON::XS
sudo cpan
install JSON::PP
exit
Hope this helps someone.

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 ... .

Perl: cmpthese text vs anonymous sub problems with parameters passed

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=\&target;
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.

In Perl, how can I find out if my file is being used as a module or run as a script?

Let's say I have a Perl file in which there are parts I need to run only when I'm called as a script. I remember reading sometime back about including those parts in a main() method and doing a
main() unless(<some condition which tests if I'm being used as a module>);
But I forgot what the condition was. Searching Google hasn't turned out anything fruitful. Can someone point out the right place to look for this?
If the file is invoked as a script, there will be no caller so you can use:
main() unless caller;
See brian d foy's explanation.
#!/usr/bin/perl
use strict;
use warnings;
main() unless caller;
sub main {
my $obj = MyClass->new;
$obj->hello;
}
package MyClass;
use strict;
use warnings;
sub new { bless {} => shift };
sub hello { print "Hello World\n" }
no warnings 'void';
"MyClass"
Output:
C:\Temp> perl MyClass.pm
Hello World
Using from another script:
C:\Temp\> cat mytest.pl
#!/usr/bin/perl
use strict;
use warnings;
use MyClass;
my $obj = MyClass->new;
$obj->hello;
Output:
C:\Temp> mytest.pl
Hello World
I call these things "modulinos" originally in my Scripts as Modules article for The Perl Journal (now Dr. Dobbs). Google that term and you get the right resources. Sinan already linked to my development sources for one of my books where I talk about it. You might also like How a Script Becomes a Module.
Better to not do this, and instead take a structured approach like MooseX::Runnable.
Your class will look like:
class Get::Me::Data with (MooseX::Runnable, MooseX::Getopt) {
has 'dsn' => (
is => 'ro',
isa => 'Str',
documentation => 'Database to connect to',
);
has 'database' => (
is => 'ro',
traits => ['NoGetopt'],
lazy_build => 1,
);
method _build_database {
Database->connect($self->dsn);
}
method get_data(Str $for_person){
return $database->search({ person => $for_person });
}
method run(Str $for_person?) {
if(!$defined $for_person){
print "Type the person you are looking for: ";
$for_person = <>;
chomp $for_person;
}
my #data = $self->get_data($for_person);
if(!#data){
say "No data found for $for_person";
return 1;
}
for my $data (#data){
say $data->format;
}
return 0;
}
}
Now you have a class that can be used inside your program easily:
my $finder = Get::Me::Data->new( database => $dbh );
$finder->get_data('jrockway');
Inside an interactive script that is bigger than just the "run" method above:
...
my $finder = Get::Me::Data->new( dsn => 'person_database' );
$finder->run('jrockway') and die 'Failure'; # and because "0" is success
say "All done with Get::Me::Data.";
...
If you just want to do this standalone, you can say:
$ mx-run Get::Me::Data --help
Usage: mx-run ... [arguments]
--dsn Database to connect to
$ mx-run Get::Me::Data --dsn person_database
Type the person you are looking for: jrockway
<data>
$ mx-run Get::Me::Data --dsn person_database jrockway
<data>
Notice how little code you wrote, and how flexible the resulting class is. "main if !caller" is nice, but why bother when you can do better?
(BTW, MX::Runnable has plugins; so you can easily increase the amount of debugging output you see, restart your app when the code changes, make the app persistent, run it in the profiler, etc.)