Call from a code reference in Template Toolkit - perl

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!

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

Using undefined constant in perl file not throwing any warning

I have a module where I have few variables declared hfs_const.pm. I
am using this module in another Perl program.
I am also using few of the module's variables in another Perl file.
Test case: I remove one variable from the module which I am using in the Perl file through an object. Then I compile the Perl file.
I am using use strict and use warnings, but when I compile the Perl program it shows that everything is OK.
I believe it should have thrown an error for undeclared module variable.
Following is the module and Perl file
hfs_const.pm
#!/usr/bin/perl
package hfs_const; # const definition file for hfs.
use Exporter 'import';
use strict;
use warnings;
#--------------------------------------------------------------------------------------
use constant ENABLE_HFS => 1;
use constant PROC_MOUNT_DIR => "/proc/fs/hydrafs/hfsd/mount";
#use constant PROC_MOUNT_DIR =>"/export/proc";
use constant PROC_HFSD_INFO_FILE => "/proc/fs/hydrafs/hfsd/info";
use constant DEBUG => 0;
use constant IGNORE_SERVICE => 0;
#use constant MAX_HFS_PER_AN =>250;
#use constant RETRY_COUNT =>3;
use constant GET_ALL_HFS_TIMEOUT => 12;
#use constant HFS_COUNT_TO_CHANGE_AN =>250;
use constant CREATING_TIME => 600;
#our $bar=4;
sub new {
my $class = shift;
my $this = {};
bless $this, $class;
return $this;
}
sub getname {
my $this = shift;
print "Ankur";
}
1;
hfs.pl
#!/usr/bin/perl
#
use strict;
use warnings;
use hfs_const;
my $const = new hfs_const();
my $isRO = 3;
if ( $isRO != 4 ) {
print $hfs_const::bar;
print hfs_const::RETRY_COUNT;
print $const->HFS_COUNT_TO_CHANGE_AN;
print hfs_const::MAX_HFS_PER_AN;
}
else {
print hfs_const::GET_ALL_HFS_TIMEOUT;
}
$const->getname();
I get the following warning on compilation
int#mint-VirtualBox ~ $ perl -c hfs.pl
Name "hfs_const::RETRY_COUNT" used only once: possible typo at hfs.pl line 12.
Name "hfs_const::MAX_HFS_PER_AN" used only once: possible typo at hfs.pl line 14.
Name "hfs_const::bar" used only once: possible typo at hfs.pl line 11.
hfs.pl syntax OK
But I do not receive any warning for constant HFS_COUNT_TO_CHANGE_AN which is used through object.
Can anybody explain why is it happening?
You're treating HFS_COUNT_TO_CHANGE_AN as a method ($const->HFS_COUNT_TO_CHANGE_AN) so Perl won't check that it exists at compile time. You'll get a run-time error though.

Why can't I initialize the member variable inside the new?

I am trying to undestand OO in Perl. I made the following trivial class:
#/usr/bin/perl
package Tools::Util;
use strict;
use warnings;
my $var;
sub new {
my ($class, $arg) = #_;
my $small_class = {
var => $arg,
};
return bless $small_class;
}
sub print_object {
print "var = $var\n"; #this is line 20
}
1;
And this is a test script:
#!/usr/bin/perl
use strict;
use warnings;
use Tools::Util;
my $test_object = new Tools::Util("Some sentence");
$test_object->print_object();
use Data::Dumper;
print Dumper($test_object);
The result I get is:
Use of uninitialized value $var in concatenation (.) or string at Tools/Util.pm line 20.
var =
$VAR1 = bless( {
'var' => 'Some sentence'
}, 'Tools::Util' );
I can not understand this. I thought that objects in Perl are hashes and so I could access/initialize the member variables using the same names without a $. Why in this case the $var is not initialized but the hash that I Dump contains the value?
How should I use/initialize/handle member variables and what am I misunderstanding here?
$var is lexical class variable, and undefined in your example.
You probably want:
sub print_object {
my $self = shift;
print "var = $self->{var}\n";
}
Perl doesn't handle object methods in quite the same way that you're used to.
Are you familiar with the implicit this argument that many object-oriented languages use? If not, now would be a great time to read up on it.
Here's a five-second introduction that glosses over the details:
//pretend C++
//this function signature
MyClass::MyFunction(int x);
//is actually more like the following
MyClass::MyFunction(MyClass this, int x);
When you access instance members of the class, my_var is equivalent to this.my_var.
In Perl, you get to do this manually! The variable $var is not equivalent to $self->{var}.
Your blessed object is actually a hash reference, and can be accessed as such. When you call $test_object->print_object(), the sub gets the value of $test_object as its first argument. Most Perl programmers handle this like so:
sub my_method {
my $self = shift; #shift first argument off of #_
print $self->{field};
}
With that in mind, you should probably rewrite your print_object sub to match mpapec's answer.
Further reading: perlsub, perlobj

WWW:Facebook::API used in perl

I am getting www:Facebook:api in perl and CPAN
error while using the Use of uninitialized value within %field in hash element at /usr/share/perl5/WWW/Facebook/API/Auth.pm line 62.
i defined all keys
#!/usr/bin/perl -w
use strict;
use warnings;
use CGI;
use WWW::Facebook::API;
use WWW::Facebook::API::Auth;
use HTTP::Request;
use LWP;
my $TMP = $ENV{HOME}.'/tmp';
my $facebook_api = '--------';
my $facebook_secret = '-------';
my $facebook_clientid = '--------';
my $gmail_user = '-------';
my $gmail_password = '--------';
my $client = WWW::Facebook::API->new(
desktop => 1,
api_version => '1.0',
api_key => $facebook_api,
secret => $facebook_secret,
throw_errors => 1,
);
$client->app_id($facebook_clientid);
local $SIG{INT} = sub {
print "Logging out of Facebookn";
my $r = $client->auth->logout;
exit(1);
};
my $token = $client->auth->create_token;
print "$token \n";
$client->auth->get_session($token);
print "$client \n";
WWW::Facebook::API doesn't look like it's been updated for a while. Line 62 of that file is:
$self->base->{ $field{$key} } = $resp->{$key};
The undefined value is the $field{$key} part. The %fieldhash is a hard-coded mapping between the names of Facebook API's known fields (i.e. the fields in the data Facebook returns to you) and the names which the module wants them to be called. It seems that Facebook has added some additional fields to its data, and the module has not been updated to deal with them.
Ultimately, this is just a warning; you can just ignore it if you like. If you want your script's output to be a bit tidier, you could change that line to:
$self->base->{ $field{$key} } = $resp->{$key} if defined $field{$key};

How do I interpolate variables to call a Perl function from a module?

Requirement is to pass module name and function name from the command-line argument.
I need to get the command-line argument in the program and I need to call that function from that module
For example, calling a try.pl program with 2 arguments: MODULE1(Module name) Display(Function name)
perl try.pl MODULE1 Display
I want to some thing like this, but its not working, please guide me:
use $ARGV[0];
& $ARGV[0]::$ARGV[1]();
Assuming the function is not a class method, try this:
#!/usr/bin/perl
use strict;
use warnings;
my ( $package, $function ) = #ARGV;
eval "use $package (); ${package}::$function()";
die $# if $#;
Keep in mind that this technique is wide open to code injection. (The arguments could easily contain any Perl code instead of a module name.)
There's many ways to do this. One of them is:
#!/usr/bin/perl
use strict;
use warnings;
my ( $package, $function ) = #ARGV;
eval "use $package; 1" or die $#;
$package->$function();
Note the the first argument of the function will be $package.
Assuming the module exports the function, this should do:
perl -Mmodule -e function
If you want to make sure your perl script is secure (or at least, prevent yourself from accidentally doing something stupid), I'd avoid doing any kind of eval on data passed in to the script without at least some kind of checking. But, if you're doing some kind of checking anyway, and you end up explicitly checking the input, you might as well explicitly spell out witch methods you want to call. You could set up a hash with 'known good' methods, thus documenting everything that you want callable and protecting yourself at the same time.
my %routines = (
Module => {
Routine1 => \&Module::Method,
Routine2 => \&Module::Method2,
},
Module2 => {
# and so on
},
);
my $module = shift #ARGV;
my $routine = shift #ARGV;
if (defined $module
&& defined $routine
&& exists $routines{$module} # use `exists` to prevent
&& exists $routines{$module}{$routine}) # unnecessary autovivication
{
$routines{$module}{$routine}->(#ARGV); # with remaining command line args
}
else { } # error handling
As a neat side effect of this method, you can simply iterate through the methods available for any kind of help output:
print "Available commands:\n";
foreach my $module (keys %routines)
{
foreach my $routine (keys %$module)
{
print "$module::$routine\n";
}
}
As per Leon's, if the perl module doesn't export it, you can call it like so
perl -MMyModule -e 'MyModule::doit()'
provided that the sub is in that package.
If it exports the sub all the time (in #EXPORT), then Leon's will work:
perl -MMyModule -e doit
If it is an optional export (in #EXPORT_OK), then you can do it like this.
perl -MMyModule=doit -e doit
But the first will work in any case where the sub is defined to the package, and I'd probably use that one over the last one.
Always start your Perl like this:
use strict;
use warnings 'all';
Then do this:
no strict 'refs';
my ($class, $method) = #_;
(my $file = "$class.pm") =~ s/::/\//g;
require $file;
&{"$class\::$method"}();
Whatever you do, try not to eval "$string" ever.
Well, for your revised question, you can do this:
use strict;
use warnings;
{
no strict;
use Symbol qw<qualify>;
my $symb = qualify( $ARGV[1], $ARGV[0] );
unless ( defined &{$symb} ) {
die "&$ARGV[1] not defined to package $ARGV[0]\::";
}
&{$symb};
}
And because you're specifying it on the command line, the easiest way to include from the command line is the -M flag.
perl -MMyModule try.pl MyModule a_subroutine_which_does_something_cool
But you can always
eval "use $ARGV[0];";
But that's highly susceptible to injection:
perl try.pl "Carp; `do something disastrous`;" no_op
I'd use UNIVERSAL::require. It allows you to require or use a module from a variable. So your code would change to something like this:
use UNIVERSAL::require;
$ARGV[0]->use or die $UNIVERSAL::require::ERROR;
$ARGV[0]::$ARGV[1]();
Disclaimer: I did not test that code and I agree Robert P's comment about there probably being a better solution than passing these as command line arguments.