Catalyst: how declare a global subroutine - perl

Hi i don't want to repeate the same code in the controllers, so i created a sub in the main MyApp package:
sub do_stuff {
my $input = shift;
do something
}
But then i want to use it in controller MyApp::Controller::Foo
sub test : Chained('base') Args(0) {
my ($self, $c) = #_;
my $test = do_stuff($c->request->params->{s});
do something more
}
i get following error:
Caught exception in MyApp::Controller::Foo->test "Undefined subroutine
&MyApp::Controller::Foo::do_stuff called at
/home/student/workspace/MyApp/script/../lib/MyApp/Controller/Foo.pm
line 24, line 1000."
How can i create a subroutine / function to use global in all Catalyst Controllers???

In principle it is already available in all the modules that were used by your main MyApp.
But if it is defined in the main package, you must either call it from within that namespace (either main or your MyApp namespace), or import it into your current package namespace.
Depending on where it was defined, use one of those ways.
my $test = main::do_stuff($c->request->params->{s});
my $test = MyApp::do_stuff($c->request->params->{s});
The alternative is to import it into your namespace in each package.
package MyApp::Controller::Foo;
if (defined &MyApp::do_stuff) {
*do_stuff = *MyApp::do_stuff;
}
With defined you can check whether a subroutine exists.
On another note, maybe this do_stuff sub is better placed inside another module that has Exporter. You can use it in all your controllers or other modules where you need it, and Exporter will take care of importing it into your namespace on its own.

The context object ($c) that you pass to most methods in Catalyst is already an object of type MyApp, so if you say
$c->do_stuff($c->request->params->{s})
it is the same as calling
MyApp::do_stuff($c, $c->request->params->{s});
If you expect your global subroutines to make use of this context object, then you'll want to consider writing them as methods (i.e., subroutines in a package where the first argument is always an instance of the package):
# to be called like $c->do_stuff("s") to do something with form input "s"
sub do_stuff {
my ($c, $param) = #_;
... do something with $c->request->param($param) ...
}

Related

Perl Import Package in different Namespace

is it possible to import (use) a perl module within a different namespace?
Let's say I have a Module A (XS Module with no methods Exported #EXPORT is empty) and I have no way of changing the module.
This Module has a Method A::open
currently I can use that Module in my main program (package main) by calling A::open I would like to have that module inside my package main so that I can directly call open
I tried to manually push every key of %A:: into %main:: however that did not work as expected.
The only way that I know to achieve what I want is by using package A; inside my main program, effectively changing the package of my program from main to A.
Im not satisfied with this. I would really like to keep my program inside package main.
Is there any way to achieve this and still keep my program in package main?
Offtopic: Yes I know usually you would not want to import everything into your namespace but this module is used by us extensively and we don't want to type A:: (well the actual module name is way longer which isn't making the situation better)in front of hundreds or thousands of calls
This is one of those "impossible" situations, where the clear solution -- to rework that module -- is off limits.
But, you can alias that package's subs names, from its symbol table, to the same names in main. Worse than being rude, this comes with a glitch: it catches all names that that package itself imported in any way. However, since this package is a fixed quantity it stands to reason that you can establish that list (and even hard-code it). It is just this one time, right?
main
use warnings;
use strict;
use feature 'say';
use OffLimits;
GET_SUBS: {
# The list of names to be excluded
my $re_exclude = qr/^(?:BEGIN|import)$/; # ...
my #subs = grep { !/$re_exclude/ } sort keys %OffLimits::;
no strict 'refs';
for my $sub_name (#subs) {
*{ $sub_name } = \&{ 'OffLimits::' . $sub_name };
}
};
my $name = name('name() called from ' . __PACKAGE__);
my $id = id('id() called from ' . __PACKAGE__);
say "name() returned: $name";
say "id() returned: $id";
with OffLimits.pm
package OffLimits;
use warnings;
use strict;
sub name { return "In " . __PACKAGE__ . ": #_" }
sub id { return "In " . __PACKAGE__ . ": #_" }
1;
It prints
name() returned: In OffLimits: name() called from main
id() returned: In OffLimits: id() called from main
You may need that code in a BEGIN block, depending on other details.
Another option is of course to hard-code the subs to be "exported" (in #subs). Given that the module seems to be immutable in practice this option is reasonable and more reliable.
This can also be wrapped in a module, so that you have the normal, selective, importing.
WrapOffLimits.pm
package WrapOffLimits;
use warnings;
use strict;
use OffLimits;
use Exporter qw(import);
our #sub_names;
our #EXPORT_OK = #sub_names;
our %EXPORT_TAGS = (all => \#sub_names);
BEGIN {
# Or supply a hard-coded list of all module's subs in #sub_names
my $re_exclude = qr/^(?:BEGIN|import)$/; # ...
#sub_names = grep { !/$re_exclude/ } sort keys %OffLimits::;
no strict 'refs';
for my $sub_name (#sub_names) {
*{ $sub_name } = \&{ 'OffLimits::' . $sub_name };
}
};
1;
and now in the caller you can import either only some subs
use WrapOffLimits qw(name);
or all
use WrapOffLimits qw(:all);
with otherwise the same main as above for a test.
The module name is hard-coded, which should be OK as this is meant only for that module.
The following is added mostly for completeness.
One can pass the module name to the wrapper by writing one's own import sub, which is what gets used then. The import list can be passed as well, at the expense of an awkward interface of the use statement.
It goes along the lines of
package WrapModule;
use warnings;
use strict;
use OffLimits;
use Exporter qw(); # will need our own import
our ($mod_name, #sub_names);
our #EXPORT_OK = #sub_names;
our %EXPORT_TAGS = (all => \#sub_names);
sub import {
my $mod_name = splice #_, 1, 1; # remove mod name from #_ for goto
my $re_exclude = qr/^(?:BEGIN|import)$/; # etc
no strict 'refs';
#sub_names = grep { !/$re_exclude/ } sort keys %{ $mod_name . '::'};
for my $sub_name (#sub_names) {
*{ $sub_name } = \&{ $mod_name . '::' . $sub_name };
}
push #EXPORT_OK, #sub_names;
goto &Exporter::import;
}
1;
what can be used as
use WrapModule qw(OffLimits name id); # or (OffLimits :all)
or, with the list broken-up so to remind the user of the unusual interface
use WrapModule 'OffLimits', qw(name id);
When used with the main above this prints the same output.
The use statement ends up using the import sub defined in the module, which exports symbols by writing to the caller's symbol table. (If no import sub is written then the Exporter's import method is nicely used, which is how this is normally done.)
This way we are able to unpack the arguments and have the module name supplied at use invocation. With the import list supplied as well now we have to push manually to #EXPORT_OK since this can't be in the BEGIN phase. In the end the sub is replaced by Exporter::import via the (good form of) goto, to complete the job.
You can forcibly "import" a function into main using glob assignment to alias the subroutine (and you want to do it in BEGIN so it happens at compile time, before calls to that subroutine are parsed later in the file):
use strict;
use warnings;
use Other::Module;
BEGIN { *open = \&Other::Module::open }
However, another problem you might have here is that open is a builtin function, which may cause some problems. You can add use subs 'open'; to indicate that you want to override the built-in function in this case, since you aren't using an actual import function to do so.
Here is what I now came up with. Yes this is hacky and yes I also feel like I opened pandoras box with this. However at least a small dummy program ran perfectly fine.
I renamed the module in my code again. In my original post I used the example A::open actually this module does not contain any method/variable reserved by the perl core. This is why I blindly import everything here.
BEGIN {
# using the caller to determine the parent. Usually this is main but maybe we want it somewhere else in some cases
my ($parent_package) = caller;
package A;
foreach (keys(%A::)) {
if (defined $$_) {
eval '*'.$parent_package.'::'.$_.' = \$A::'.$_;
}
elsif (%$_) {
eval '*'.$parent_package.'::'.$_.' = \%A::'.$_;
}
elsif (#$_) {
eval '*'.$parent_package.'::'.$_.' = \#A::'.$_;
}
else {
eval '*'.$parent_package.'::'.$_.' = \&A::'.$_;
}
}
}

Perl using a variable to reference a module messes up passing parameters

I have a problem when using a variable to reference a module, it seems to mess up the passing of the variables:
TOTO.pm
package TOTO;
use Data::Dumper;
sub print {
print Dumper(#_);
}
Perl program
package main;
TOTO::print('Hello World');
print ">>>>>>>>>>>\n";
my $package = 'TOTO';
$package->print('Hello World');
And the output is:
$VAR1 = 'Hello World';
>>>>>>>>>>>
$VAR1 = 'TOTO';
$VAR2 = 'Hello World';
Any advice on how to avoid having TOTO passed as the first variable?
Short: The observed behavior comes from use of -> on a package name.
The arrow operator is used with a reference or with an object, which itself is a reference to a data structure that has been bless-ed into its class. (Or with a class name, see below.) That object or the class name is quietly passed as the first argument so that the whole system would work. Note that the package in the question does not define a class (objects cannot be created with it).
From Arrow operator in perlop
"-> " is an infix dereference operator, just as it is in C and C++. If the right side is either a [...] , {...} , or a (...) subscript, then the left side must be either a hard or symbolic reference to an array, a hash, or a subroutine respectively. (Or technically speaking, a location capable of holding a hard reference, if it's an array or hash reference being used for assignment.) See perlreftut and perlref.
It continues, to statements of direct interest in this problem
Otherwise, the right side is a method name or a simple scalar variable containing either the method name or a subroutine reference, and the left side must be either an object (a blessed reference) or a class name (that is, a package name). See perlobj.
So in uses related to classes the left-hand side may contain the class name, and class methods can then be invoked on it (or it can be just queried). Given that a class is a package then this is a package name.
The situation in the question falls within this so the package name is passed to the subroutine. However, according to the above quote it seems that the sub can only be a method, which isn't the case here. So it may be that this use of -> should really be disallowed. Either way, using it on a package which isn't a class strikes me as mistaken.
Update to clarification. This use was intended, to resolve an ambiguity in which package was loaded. The package name is saved into a variable and then the sub invoked on it, using the arrow operator. In this case code would have to be added to the sub to handle the first argument (package name) which is passed regardless of the invocation, by the courtesy of the arrow operator. But then we would have to allow a case when this is invoked on an object, ending up with a code that covers two distinct uses. I believe that it is better to change to a design that does not involve all this.
If you want to use a package, say as a library
File TOTO.pm
pacakge TOTO;
use Exporter;
our (#ISA, #EXPORT_OK);
#ISA = ('Exporter');
#EXPORT_OK = qw(prn); # This can be asked for by user of package
use Data::Dumper;
sub prn {
print Dumper(#_);
}
1; # important for 'require' when this is used
I've changed the sub name to prn so that it's not a Perl library function. The main script
use warnings;
use strict;
use TOTO qw(prn);
prn("Hello World");
The fully qualified name TOTO::prn() can always be used. If you wanted to make this a class that would require a bit more in the package.
This package, TOTO, does not export anything by default, unless asked for. That's what #EXPORT_OK sets up and that's why we need to list functions to import into main:: when use TOTO. Start, for example, with perlmod
In the simplest terms, to create an object-oriented TOTO module you must create a file TOTO.pm that contains at least a constructor subroutine new
package TOTO;
sub new {
bless {};
}
sub print {
print "I am a TOTO object\n";
}
1;
That code must be saved in a file called TOTO.pmthat must match the package TOTO name in the source
Then you may write a program, say main.pl, that uses that module. For instance
use strict;
use warnings 'all';
use TOTO;
my $object = TOTO->new;
$object->print;
And then you have created a new TOTO object that says what it is
If I run
$ perl main.pl
I get the output
I am a TOTO object
You will want to make this code more useful, and there are many variations on this theme, but those are the basics
That's just how Perl's package system works. You need to handle this yourself in the sub being called. You can't change it prior to the call.
sub print {
# special variable __PACKAGE__ contains "TOTO"
if ($_[0] eq __PACKAGE__ || ref $_[0] eq __PACKAGE__){
shift; # throw away class/object
}
print Dumper(#_);
}
The ref $_[0] part isn't technically needed, because you don't have a constructor in your class (you call the method on the class only, but it will just do the right thing if you ever do use objects without having to change anything later).
Here's the issue
Any advice on how to avoid having TOTO passed as the first variable?
You've discovered the answer yourself. This works fine
TOTO::print('Hello World');
If you call it as
TOTO->print('Hello World');
then you're asking for perl to call print as a class method and pass ('TOTO', 'Hello World') as parameters to the TOTO::print subroutine
If TOTO is just a bunch of subroutines then, as you found, just call TOTO::totosub
Check differences between this:
TOTO::print("Hello World");
and
TOTO->print("Hello World");
which is not proper object notation, because TOTO is just a string.
Syntaxe object->function(arguments) whil pass object as 1st argument, to be stored as $this, for sample.
sub print {
my $this = shift #_;
print Dumper(#_);
}
May do the job (even if not blessed object).
Try this:
package TOTO;
use Data::Dumper;
sub new { return bless {}, shift; }
sub print {
my $self = shift #_;
if ( scalar $self =~ /=HASH\(/ ) {
print Dumper(#_);
} else {
print Dumper($self);
}
}
package main;
my $package = TOTO->new();
$package->print("Hello World");
TOTO::print("Hello World");
This could output:
$VAR1 = 'Hello World';
$VAR1 = 'Hello World';
And have a look at man perlobj, man perlootut and man perlmodlib

when using strict, perl can't find a child class method

I am having an issue when using strict in perl. I have a parent class called FlowStep and I have a child classes FlowStep_* which I want to inherit from FlowStep. FlowStep is loaded by perl immediately when I run. Depending on what flow step the user wishes to run, there is code to dynamically load the particular package for that step. For example, if the user runs "myFlowManager -step foo", the made flow manager code will run, determine the package for step foo, and load it.
So basically some code that says something like:
sub runPerlModule {
my $this = shift;
my $PMfullPath = $$this{"subPM"} ;
my $path = dirname($PMfullPath);
my $module = basename($PMfullPath, ".pm");
# dynamically load the module
push(#INC, $path);
eval "require $module";
# create a new object
my $obj = $module->new();
# call the child class's init code
$obj->init();
$obj->run();
}
One example flow step is called FlowStep_RunTiming. In FlowStep_RunTiming, I have the following:
use FlowStep;
use strict;
package FlowStep_RunTiming;
use base qw(FlowStep); #i think this is the only command needed to setup inheritance
sub new {
# some code to create
}
sub run {
# some code to run
}
1;
I am having a problem when using strict in FlowStep_RunTiming. If there are no syntax errors in FlowStep_RunTiming, there are no issues. If however there is a typo in FlowStep_RunTiming, then when I run the program, perl just complains that there is no run() method defined for FlowStep_RunTiming.
The package FlowStep_RunTiming is dynamically selected, so execution begins before perl can lint it. There must be a way though for perl to report the real issue, ie report the syntax error and line number with the error in FlowStep_RunTiming. Right now have to run, fail, and find the syntax error by eye.
Am I not setting up the child class correctly? Is there a way to make perl report the real syntax error and not give the "false" message that run() isn't defined. Anyone have any example of how to set this up correctly?
Thanks for your help.
Change eval "require $module"; to
unless (eval "require $module") {
die "Error in $module: $#";
}
Or do whatever else you want to when there's a typo.
See perldoc perlvar and perldoc -f eval.
In the child I do this; Service is the parent perl
use Service;
our #ISA= qw( Service );
sub new
{
my ($class, $args) = #_;
my $self = $class->SUPER::new($args );
bless $self, $class;
return $self;
}
sub prerun{ #something calling run
my ($self) = #_;
$self->run(); #self becomes the first argument to run
}
and you need to pass the class/object into each function
in parent;
sub run
{
my ($self) = #_;
}
Then from the child

Perl export to child modules

I have this parent module MyApp.pm:
package MyApp;
use Moose;
use base 'Exporter';
our #EXPORT = qw(msg);
sub msg {
print "Hello msg\n";
}
1;
which is inherited by this child module MyApp2.pm:
package MyApp2;
use Moose;
extends qw(MyApp);
1;
and when used in the App.cgi script like this:
#!/usr/bin/perl
use MyApp2;
msg();
I get error message:
Undefined subroutine &main::msg called at App.cgi line 3.
So the exported function does not work in the child class MyApp2 but works only if I use "use MyApp" instead of "use MyApp2". I assume the exported function should be accessible to the child modules also which is extending the parent class. What I am doing wrong.
Inheritance only changes how method calls are handled; function calls or variable accesses (like our #EXPORT) are not affected.
Instead of exporting a function, you could use it as a method:
use MyApp2;
MyApp2->msg;
but in this case, it would be cleaner to explicitly load MyApp in order to import the msg function, and to additionally load MyApp2 in order to load this class.
use MyApp;
use MyApp2;
msg;
It is generally advisable for a module to either be object oriented or to offer an interface via exported functions, but not do both.
Here is the solution I found for my request:
package MyApp;
use Moose;
use base 'Exporter';
our #EXPORT = qw(msg);
sub import {
my ($class, #args) = #_;
my $caller = $class.'::';
{
no strict 'refs';
#{$caller.'EXPORT'} = #EXPORT;
foreach my $sub (#EXPORT) {
next if (*{"$caller$sub"}{CODE});
*{"$caller$sub"} = \*{$sub};
}
}
goto &Exporter::import;
}
sub msg {
print "Hello msg MyApp\n";
}
1;
The idea here is I export all the contents of the "#EXPORT" array into the child module, only add none existent subs so will not overwrite any methods in the child class.
In this example above, this exports from MyApp to the child MyApp2.
This works for my own needs.

Perl packages: how to import classes into the 'use'r's namespace?

I'm working on a package that defines exceptions (using Exception::Class::Nested) for its 'parent' package. I don't want the parent package to have to use the really long names, though, and I don't want to pollute any other namespace.
So what I'd like to do is export the last element of the class names into the namespace of the package that used the exception package.
For example, an excerpt from the exception package:
package Klass:Foo::Bar::Exceptions;
use vars qw( #ISA #EXPORT #EXPORT_OK ... );
#ISA = qw( Klass::Foo::Bar Exporter );
use Exception::Class::Nested 0.04 (
'Klass::Foo::Bar::Exceptions::BaseClass' => {
description => 'Base class for exceptions',
'Klass::Foo::Bar::Exceptions::NameError' => {
error => "I don't like your face"
}
}
);
The 'parent' package:
package Klass::Foo::Bar;
use Klass::Foo::Bar::Exceptions;
Klass::Foo::Bar::Exceptions::NameError->throw(error => "D'oh!");
my $e = NameError->new(error => 'Mwahaha!');
I'd like to export/import the exception class such that the second invocation (the my $e one) works as though NameError was defined in Klass::Foo::Bar, but I haven't figured it out yet.
(And before anyone says 'but Exception::Class has the nifty alias thingy,' I'll point out that the alias name is linked specifically to the exception's throw method, so I can't use that for non-auto-thrown new invocations..)
One thing I tried is putting this in the exception package's importer sub (#snames is either an array of the fully-qualified exception classes (e.g., 'Klass::Foo::Bar::Exceptions::NameError'), or just the tail end (e.g., 'NameError'):
my $caller = caller();
$caller ||= 'main';
my #snames = #{$EXPORT_TAGS{exceptions}};
for my $exc (#snames) {
$exc =~ s/^.*:://;
no strict qw(subs refs);
*{"${caller}\:\:${exc}\:\:"} = \*{__PACKAGE__ . "\:\:${exc}\:\:"};
}
But this ends up requiring me to invoke the exceptions using Klass::Foo::Bar::NameError rather than just NameError. It seems it works, but too well.
I don't want to import NameError into main::!
Typeglobs and symbol tables are still a bit mysterious to me, I'm afraid.
I'm sure there's a way to do what I want (or else I'm doing something that I shouldn't altogether, but let's leave that alone for now). Can anyone help me with this?
Thanks!
In your example import sub, you are aliasing package stashes, which is not going to do what you want. Instead, you want to create subroutines with the shortened names that return the full package name:
sub import {
my $caller = caller;
for my $long (#{$EXPORT_TAGS{exceptions}}) { # for each full name
my ($short) = $long =~ /([^:]+)$/; # grab the last segment
no strict 'refs';
*{"$caller\::$short"} = sub () {$long}; # install a subroutine named
# $short into the caller's pkg
# that returns $long
}
}
Breaking apart that last line, sub () {$long} creates an anonymous subroutine that takes no arguments. The code reference contains the single variable $long which retains the value it had during the loop iteration. This is called a lexical closure, which basically means that the subroutine's compilation environment ($long and it's value) will persist as long as the subroutine does.
This anonymous subroutine is then installed into the caller's package with the $short name. The fully qualified name of a subroutine in the caller's package is caller::subname, which "$caller\::$short" constructs. This is then dereferenced as a typeglob *{ ... }. Assignment to a typeglob with a reference fills that slot of the typeglob. So assigning a code reference installs the subroutine.
Put another way, the following subroutine declaration:
sub short () {'a::long::name'}
means the same thing as:
BEGIN {*{__PACKAGE__.'::short'} = sub () {'a::long::name'}}