th_foo.pm
package Foo;
use Exporter 'import';
our #EXPORT = 'foo';
sub foo { print "foo\n"; }
sub bar { print "bar\n"; }
1;
Case 1
main.pl
use lib '.';
delete $INC{ 'th_foo.pm' };
require 'th_foo.pm';
'Foo'->import();
foo();
Result
$ perl main.pl
foo
Case 2
main.pl
use lib '.';
delete $INC{ 'th_foo.pm' };
require 'th_foo.pm';
'th_foo.pm'->import();
foo();
Result
$ perl main.pl
Undefined subroutine &main::foo called at th.pl line 9.
Question
Can we call Foo's import method by only knowing the file name, th_foo.pm, and not knowing the package name, Foo?
There is no way to get the packages used by an executed file.
You could scan the symbol table beforehand and afterwards and check for differences, but that will also include symbols created by modules used by the file you are executing.
If you can control the th_foo.pm file, you can use the last evaluated expression to pass back information through the require. This only works the first time you require the file in a program, but you're already playing the %INC.
package Foo;
use Exporter 'import';
our #EXPORT = 'foo';
sub foo { print "foo\n"; }
sub bar { print "bar\n"; }
__PACKAGE__;
Then, in the program:
my $package = require 'th_foo.pm';
$package->import;
Again, this is fragile because you must be the first require on that file (otherwise it just returns a boolean). But, in one case I have done something like this, which is sure to get you a beating in code review:
sub my_require ( $file ) {
state %cache;
my $rc = require $file;
$cache{$file} //= $rc;
}
I do this for all of my Makefile.PL files in my Perl dists (example in object-iterate). When I want to process all of my distributions to do something (like, which ones have a minimum version of v5.8?), I require the Makefile.PL and know which package I'm dealing with (although the repo path works too but needs more work).
Curiously, there is a suggestion that we should remove the true value from the end of Perl modules. David Farrell wrote about it in Patching Perl: loading modules that return false and it's now an issue for Perl 7. This doesn't affect the return value though; it just doesn't complain if you return false or empty. It knows it failed through other means.
Related
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::'.$_;
}
}
}
I'm working with a module that makes use of some prototypes to allow code blocks. For example:
sub SomeSub (&) { ... }
Since prototypes only work when parsed at compile time, I'd like to throw a warning or even a fatal if the module is not parsed at compile time. For example:
require MyModule; # Prototypes in MyModule won't be parsed correctly
Is there a way to detect if something is being executed at compile or run time/phase in Perl?
If you're running on Perl 5.14 or higher, you can use the special ${^GLOBAL_PHASE} variable which contains the current compiler state. Here's an example.
use strict;
use warnings;
sub foo {
if ( ${^GLOBAL_PHASE} eq 'START' ) {
print "all's good\n";
} else {
print "not in compile-time!\n";
}
}
BEGIN {
foo();
};
foo();
Output:
all's good
not in compile-time!
Before 5.14 (or on or after, too), you can do:
package Foo;
BEGIN {
use warnings 'FATAL' => 'all';
eval 'INIT{} 1' or die "Module must be loaded during global compilation\n";
}
but that (and ${^GLOBAL_PHASE}) doesn't quite check what you want to know, which is whether the code containing the use/require statement was being compiled or run.
I had exported some constants from my module. In my script I am loading my module using Mojo::Loader
my module
use constant FALSE => 0;
use constant TRUE => 1;
our #EXPORT = qw(FALSE TRUE);
In my script.
Mojo::Loader->new->load($my_module_name);
I was able to use my module in my script, but the constants that I exported were not accessible in my script. If I load my module with use clause. I was able to use the exported constants.
Any idea how to fix this and import the constants into my script.
Thanks!!
I took a look at the code for Mojo::Loader and it turns out it cannot import stuff. It only does a require (in a string eval), but not a use. A quick grep of the source reveals that there is no import whatsoever, so you will need to call Your::Module->import yourself.
Here's a link to the relevant part of the source code and a quote:
sub load {
my ($self, $module) = #_;
# Check module name
return 1 if !$module || $module !~ /^\w(?:[\w:']*\w)?$/;
# Load
return undef if $module->can('new') || eval "require $module; 1";
# Exists
return 1 if $# =~ /^Can't locate \Q#{[class_to_path $module]}\E in \#INC/;
# Real error
return Mojo::Exception->new($#);
}
There is something interesting going on here. If you use foo, the import works with constants.
use foo;
print 'True: ', TRUE;
However:
require foo;
foo->import;
print 'True: ', TRUE;
This will produce a warning Bareword "TRUE" not allowed while "strict subs" in use. So we put TRUE() to make it look less like a bareword. A constant is a sub after all. Now it will work. The same goes for doing Mojo::Loader->load('foo').
If you wrap a BEGIN block around the require and import, you can omit the parenthesis.
Thus, if you want to export constants, add parenthesis to where you call them if you want to keep using Mojo::Loader.
Having a C background, I may be trying to write something the wrong way so excuse the beginner question. Here is what I'm looking for :
I'm willing to have a perl module Verbose (not a class) that define a subroutine called verbose_print(). This subroutine will print its argument (a string) only if module's variable $verbose is true. Of course, what I'm willing to do is to get the -V option from the command line (using Getopt::Long) and then, is the -V switch is on, call the Verbose module with 'true' being the value for $Verbose::verbose.
One workaround is to have a verbose_init function that set the $Verbose::verbose variable to true inside the Verbose module.
Another one was to declare $verbose in my module using our and then $Verbose::verbose = $command_line_verbose_switch in the main script.
I was wondering if there is another way to do this in perl?
Don't be so afraid of classes in Perl, they're just packages and modules treated a wee bit differently. They don't bite. However, you said no classes, so no classes.
I prefer not to touch package variables directly. Instead, I'll use a subroutine to set them.
Here's my Local::Verbose (stored under Local/Verbose.pm)
package Local::Verbose;
use strict;
use warnings;
use Exporter 'import';
# Could have used just '#EXPORT', but that's bad manners
our #EXPORT_OK = qw(verbose verbose_switch);
# Use "our", so $verbose_value is a package variable.
# This makes it survive between calls to this package
our $verbose_value;
# prints out message, but only if $verbose_value is set to non-blank/zero value
sub verbose {
my $message = shift;
if ( $verbose_value ) {
print "VERBOSE: $message\n";
return $message;
}
else {
return;
}
}
sub verbose_switch {
my $switch_value = shift;
$verbose_value = $switch_value;
return $switch_value;
}
1;
Notice the our. That makes $verbose_value a package variable which means it lives on outside of the package between calls.
Notice how I use Exporter and the #EXPORT_OK array. You can use #EXPORT which will export all of the named subroutines automatically, but it's now considered bad manners since you could end up covering over someone's local subroutine with the same name. Better make it explicit. If there's a problem, they can use the Local::Verbose::verbose name of the verbose subroutine.
And how it's used
use strict;
use warnings;
use Local::Verbose qw(verbose verbose_switch);
verbose ("This is a test");
verbose_switch(1);
verbose ("This is a second test");
By the way, imagine calling the verbose subroutine like this:
verbose($message, $my_verbose_level);
Now, your verbose subroutine could look like this:
sub verbose {
my $message = shift;
my $verbose_level = shift;
if (not defined $verbose) {
$verbose_level = 1;
}
if ( $verbose_value =< $verbose_level ) {
print "VERBOSE: $message\n";
return $message;
}
else {
return;
}
}
Now, you can set your verbose level to various values, and have your verbose statements give you different levels of verbosity. (I do the same thing, but call it debug).
One of 'another ways' is create an import function:
package Verbose;
my $verbose_on;
sub import {
$verbose_on = shift;
}
#... Your code.
Now you can set your verbose like this:
if( ... ) { #check getopt
use Verbose (1); #This will require package Verbose and call "import"
}
But, i think more simple and obivious to further use is make a function-setter.
I'm not thinking too clearly right now and possibly overlooking something simple. I've been thinking about this for a while and been searching, but can't really think of any sensible search queries anymore that would lead me to what i seek.
In short, I'm wondering how to do module inheritance, in the way base.pm/parent.pm do it for object-oriented modules; only for Exporter-based modules.
A hypothetical example of what i mean:
Here's our script. It originally loaded Foo.pm and called baz() from it, but baz() has a terrible bug (as we'll soon see), so we're using Local/Patched/Foo.pm now which should fix the bug. We're doing this, because in this hypothetical case we cannot change Foo (it is a cpan module under active development, you see), and it is huge (seriously).
#!/usr/bin/perl
# use Foo qw( baz [... 100 more functions here ...] );
use Local::Patched::Foo qw( baz [... 100 more functions here ...] );
baz();
Here's Foo.pm. As you can see, it exports baz(), which calls qux, which has a terrible bug, causing things to crash. We want to keep baz and the rest of Foo.pm though, without doing a ton of copy-paste, especially since they might change later on, due to Foo still being in development.
package Foo;
use parent 'Exporter';
our #EXPORT = qw( baz [... 100 more functions here ...] );
sub baz { qux(); }
sub qux { print 1/0; } # !!!!!!!!!!!!!
[... 100 more functions here ...]
1;
Lastly, since Foo.pm is used in MANY places, we do not want to use Sub::Exporter, as that would mean copy-pasting a bandaid fix to all those many places. Instead we're trying to create a new module that acts and looks like Foo.pm, and indeed loads 99% of its functionality still from Foo.pm and just replaces the ugly qux sub with a better one.
What follows is what such a thing would look like if Foo.pm was object-oriented:
package Local::Patched::Foo;
use parent 'Foo';
sub qux { print 2; }
1;
Now this obviously will not work in our current case, since parent.pm just doesn't do this kinda thing.
Is there a clean and simple method to write Local/Patched/Foo.pm (using any applicable CPAN modules) in a way that would work, short of copying Foo.pm's function namespace manually?
If it's one subroutine you want to override, you can do some monkey patching:
*Foo::qux = \&fixed_qux;
I'm not sure if this is the cleanest or best solution, but for a temporary stopgap until upstream fixes the bug in qux, it should do.
Just adding in yet another way to monkey-patch Foo's qux function, this one without any manual typeglob manipulation.
package Local::Patched::Foo;
use Foo (); # load but import nothing
sub Foo::qux {
print "good qux";
}
This works because Perl's packages are always mutable, and so long as the above code appears after loading Foo.pm, it will override the existing baz routine. You might also need no warnings 'redefine'; to silence any warnings.
Then to use it:
use Local::Patched::Foo;
use Foo qw( baz );
baz(); # calls the patched qux() routine
You could do away with the two use lines by writing a custom import method in Local::Patched::Foo as follows:
# in the Local::Patched::Foo package:
sub import {
return unless #_; # return if no imports
splice #_, 0, 1, 'Foo'; # change 'Local::Patched::Foo' to 'Foo'
goto &{ Foo->can('import') }; # jump to Foo's import method
}
And then it is just:
use Local::Patched::Foo qw( baz );
baz(); # calls the patched qux()
Rather than hijacking Alexandr's answer (which was correct, but incomplete), here's a solution under separate copy:
package Foo;
use Exporter 'import';
our #EXPORT = qw(foo bar baz qux);
our %EXPORT_TAGS = (
'all' => [ qw(foo bar baz qux) ],
'all_without_qux' => [ qw(foo bar baz) ],
);
sub foo { 'foo' }
sub bar { 'bar' }
sub baz { 'baz' }
sub qux { 'qux' }
1;
package Foo::Patched;
use Foo qw(:all_without_qux);
use Exporter 'import';
our #EXPORT = qw( foo bar baz qux );
sub qux { 'patched qux' }
1;
package main;
use Foo::Patched;
print qux();
You can also use Foo; in your program, as long as you use it before Foo::Patched, or you will overwrite the patched qux with the original broken version.
There are a few morals here (at least they are IMHO):
don't export into the caller's namespace without being explicitly told to (i.e. keep #EXPORT empty, and use #EXPORT_OK and %EXPORT_TAGS to allow the caller to specify exactly what they want. Or alternatively, don't export at all, and use fully-qualified names for all library functions.
Write your libraries so that the functions are called OO-style: Foo->function rather than Foo::function. This makes it much easier to override a function by using the standard use base syntax we all know and love, without having to mess around with monkeypatching symbol tables or manipulating exporter lists.
One approach is to simply replace the sub reference. if you can install it, use the Sub::Override CPAN module. Absent that, this will do:
package Local::Patched::Foo;
use Exporter;
sub baz { print "GOOD baz!\n" };
sub import() {
*Foo::baz = \&Local::Patched::Foo::baz;
}
1;
package Local::Patched::Foo;
use Foo qw/:all_without_qux/; #see Exporter docs for tags or just list all functions
use Exporter 'import'; #modern way
our #EXPORT = qw( baz [... 100 more functions here ...] qux);
sub qux { print 2; }
1;
I would suggest that you replace the offending file.
mkdir Something
cp Something.pm Something/Legacy.pm # ( or /Old.pm or /Bad.pm )
And then go in to that file and edit the package line:
package Something::Legacy;
Then you have a place to step in front of the legacy code. Create a new Something.pm and get all it's exports:
use Something::Legacy qw<:all>;
our #EXPORT = #Something::Legacy::EXPORT;
our #EXPORT_OK = #Something::Legacy::EXPORT_OK;
our %EXPORT_TAGS = %Something::Legacy::EXPORT_TAGS;
After you have all that in your current package, just re-implement the sub.
sub bad_thing { ... }
Anything your legacy code that calls Something::do_something will be calling the old code via the new module. Any legacy code calling Something::bad_thing will be calling the new code.
As well, you can manipulate *Something::Legacy in other ways. If your code does not uses a local call, you're going to have to clobber &Something::Legacy::bad_thing.
my $old_bad_thing = \&Something::Legacy::bad_thing;
*Something::Legacy::bad_thing = \&bad_thing;
Thus bad_thing is still allowed to use that behavior, if desired:
sub bad_thing {
...
eval {
$old_bad_thing->( #_ );
};
unless ( $EVAL_ERROR =~ /$hinky_message/ ) {
...
}
...
}