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::'.$_;
}
}
}
Related
Given the following module:
package My::Object;
use strict;
use warnings;
use My::Module::A;
use My::Module::B;
use My::Module::C;
use My::Module::D;
...
1;
I would like to be able to call My::Object in the next 2 scenarios:
Normal use
use My::Object;
My::Module->new();
Reduced memory use. Call the same object but with a condition or a flag telling the object to skip the use modules to reduce memory usage. Somehow like:
use My::Object -noUse;
My::Module->new();
If tried the Perl if condition without success.
The problem I'm having it's with big objects with a lot of uses, then only loading this object consumes a lot of RAM. I know I can refactor them but it will be wonderful if somehow I can avoid these uses when I'm sure none of them is used on the given scenario.
One solution will be to replace all uses with requires on all places when the modules are needed, but I don't see convenient when some of them are used in a lot of methods.
Any ideas?
Thanks
The native pragma autouse will load modules needed when plain subroutines are called:
use autouse 'My::Module::A' => qw(a_sub);
# ... later ...
a_sub "this will dynamically load My::Module::A";
For proper OO methods, Class::Autouse will load modules (classes) when methods are called:
use Class::Autouse;
Class::Autouse->autouse( 'My::Module::A' );
# ... later ...
print My::Module::A->a_method('this will dynamically load My::Module::A');
What I think you're looking for is perhaps require - require is evaluated later so you can use it successfully in a conditional:
if ( $somecondition ) {
require Some::Module;
}
Of course, you won't be able to do Some::Module->new() if you've not loaded it - there's just no way around that.
Where use is triggered at compile time (and thus will trigger warnings under perl -c if the module is unavailable) require happens are runtime. You should probably test if require was successful as a result.
e.g.:
if ( $somecondition ) {
eval { require Some::Module };
warn "Module Not loaded: ".$# if $#;
}
Otherwise you may be looking for:
Is it possible to pass parameters to a Perl module loading?
#!/usr/bin/perl
package MyObject;
sub import {
my ( $package, $msg ) = #_;
if ( defined $msg and $msg eq "NO_USE" ) {
#don't load module
}
else {
require XML::Twig;
}
}
1;
And then call:
use if $somecondition, MyObject => ( 'NO_USE' );
Or just simpler:
use MyObject qw( NO_USE );
Edit:
After a bit of fiddling with 'use' - there's a couple of gotchas, in that use if doesn't seem to like lexical variables. So you need to do something like:
#!/usr/bin/perl
package MyObject;
use strict;
use warnings;
our $import_stuff = 1;
sub import {
my ( $package, $msg ) = #_;
if ( $msg and $msg eq "NO_USE" ) {
$import_stuff = 0;
}
use if $import_stuff, 'Text::CSV';
}
1;
And call:
#!/usr/bin/perl
use strict;
use warnings;
use MyObject qw( NO_USE );
use Data::Dumper;
print Dumper \%INC;
my $test = Text::CSV -> new();
(Which errors if you set NO_USE and doesn't otherwise).
I think that's an artifact of use being a compile time directive still, so requires a (package scoped) condition.
How to pass some arguments while using a package, for example:
use Test::More tests => 21;
I wasn't able to find any valuable documentation about this featue. Are there any pros and cons of passing such arguments?
use My::Module LIST does two things: 1) It requires My::Module; and 2) Invokes My::Module->import(LIST).
Therefore, you can write your module's import routine to treat the list of arguments passed any which way you want. This becomes even easier if you are indeed writing an object oriented module that does not export anything to the caller's namespace.
Here's a rather pointless example:
package Ex;
use strict;
use warnings;
{
my $hello = 'Hello';
sub import {
my $self = shift;
my $lang = shift || 'English';
if ($lang eq 'Turkish') {
$hello = 'Merhaba';
}
else {
$hello = 'Hello';
}
return;
}
sub say_hello {
my $self = shift;
my $name = shift;
print "$hello $name!\n";
return;
}
}
__PACKAGE__;
__END__
And a script to use it:
#!/usr/bin/env perl
use strict;
use warnings;
use Ex 'Turkish';
Ex->say_hello('Perl');
Ex->import;
Ex->say_hello('Perl');
Output:
$ ./imp.pl
Merhaba Perl!
Hello Perl!
Some may say it is more readable in some scenarios, but in essence it is same as
use Test::More qw(tests 21);
(test is auto-quoted by fat comma =>, and number doesn't need quote).
The major disadvantage is that you can't use the default import subroutine from Exporter, which expects only a list of symbols (or tags denoting collections of symbols) to import into the calling package
Test::More inherits a custom import routine from the superclass Test::Builder::Module, which uses the arguments supplied in the use statement to configure the test plan. It also in turn uses Exporter to handle options specified like import => [qw/ symbols to import /]
Pretty much anything can be done by a custom import subroutine if you have a specific requirement, but it is probably unwise to stray too far from standard object-oriented semantics
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.
It's a long title, but I'm afraid I can't take a single word out without losing the true meaning of the question. I'll give a quick description of what I'm trying to achieve first, then a long rambling on why I want it done this way. Skip the rambling if you intend to directly answer abiding with the question title :-)
Quick description
Assuming the existence of a lexicalize builtin that does just what I want, here goes:
package Whatever;
{
lexicalize $Other::Package::var;
local $var = 42;
Other::Package->do_stuff; # depends on that variable internally
}
Whys and whynots
For a bit of context, I'm whitebox-testing a third-party module.
I want the variable localized because I want it changed for a limited time only, before the tests move on to something else. local is the best way I found to do this without depending on knowing the module's choice for an initial value.
I want a lexical binding for two main reasons:
I don't want to pollute the test file's higher-level namespace.
I want something shorter than the fully-qualified name. It's not in the sample code for brevity, but I use the identifier a lot more than what's shown, with calculations and updates relative to its previous value.
I couldn't decently use our because it won't grab a variable from another package: “No package name allowed for variable $Other::Package::var in "our".” Cheating to temporarily enter Other::Package's scope doesn't cut it: if I use a block ({ package Other::Package; our $var }) then the binding doesn't last long enough to be useful; and if I don't (package Other::Package; our #var; package main) then I need to know and copy the previous package's name, which prevents moving that piece of code around too much.
While doing my homework before asking a previous form of this question, I discovered Lexical::Var, which seemed like it would be exactly what I needed. Alas: “Can't localize through a reference.”
I've also tried my best on my gut feeling of my *var-based forms, but kept bumping into syntax errors. I've learned more than I cared to about scoping and binding today :-)
I can't think of a reason why what I want shouldn't be possible, but I can't find the right incantation. Am I asking for an unfortunate unimplemented edge case?
If I get you right, all you need is our. Forgive me if I dont.
Here's working example:
#!/usr/bin/env perl
use strict;
use warnings;
package Some;
our $var = 42;
sub do_stuff { return $var }
package main;
{
local $Some::var = 43;
print "Localized: " . Some->do_stuff() . "\n";
};
print "Normal: " . Some->do_stuff() . "\n";
But if you try to localize private (my) variable of some package, you probably doing something wrong.
there are several ways to do this:
given:
{package Test::Pkg;
our $var = 'init';
sub method {print "Test::Pkg::var = $var\n"}
}
alias a package variable from the current package to the target package.
{
package main;
our $var;
Test::Pkg->method; # Test::Pkg::var = init
local *var = \local $Test::Pkg::var;
# alias $var to a localized $Test::Pkg::var
$var = 'new value';
Test::Pkg->method; # Test::Pkg::var = new value
}
Test::Pkg->method; # Test::Pkg::var = init
localize through a glob reference:
{
package main;
my $var = \*Test::Pkg::var; # globref to target the local
Test::Pkg->method; # Test::Pkg::var = init
local *$var = \'new value'; # fills the scalar slot of the glob
Test::Pkg->method; # Test::Pkg::var = new value
}
Test::Pkg->method; # Test::Pkg::var = init
bind a the lexical in the target package, and let it spill into the current package:
{
package Test::Pkg; # in the target package
our $var; # create the lexical name $var for $Test::Pkg::var
package main; # enter main package, lexical still in scope
Test::Pkg->method; # Test::Pkg::var = init
local $var = 'new value';
Test::Pkg->method; # Test::Pkg::var = new value
}
Test::Pkg->method; # Test::Pkg::var = init
the last example uses a slightly awkward double package declaration to create a lexical in one package and get it into another. This trick is useful with local in other scenarios:
no strict 'refs';
local ${'Some::Pkg::'.$name} = 'something';
use strict 'refs';
I am not quite sure if I understand you correctly. Does this help?
#!/usr/bin/env perl
{
package This;
use warnings; use strict;
our $var = 42;
sub do_stuff {
print "$var\n";
}
}
{
package That;
use warnings; use strict;
use Lexical::Alias;
local $This::var;
alias $This::var, my $var;
$var = 24;
print "$var\n";
This->do_stuff;
}
package main;
use warnings; use strict;
This->do_stuff;
package Other::Package;
$var = 23;
sub say_var {
my $label = shift;
print "$label: $Other::Package::var\n";
}
package Whatever;
Other::Package::say_var("before");
{
local $Other::Package::var = 42;
local *var = \$Other::Package::var;
Other::Package::say_var("during");
print "\$Whatever::var is $var inside the block\n";
}
Other::Package::say_var("after");
print "\$Whatever::var is ",
defined($var) ? "" : "un", "defined outside the block\n";
Output:
before: 23
during: 42
$Whatever::var is 42 inside the block
after: 23
$Whatever::var is undefined outside the block
local $Other::Package::var makes the original value temporarily 42 for the duration of the block, and local *var = \$Other::Package::var makes $var in the current package an alias for $Other::Package::var temporarily for the duration of the block.
Naturally some of this isn't strict-compliant, but I avoided using our because our obfuscates the issue if both packages are in the same file (as they might be if you copy-pasted this sample) — the our declaration can leak out of the package it's used in, into a following package in the same file :)
Can someone tell me why the main does not find the methods generated by Class::Accessor in this very small and trivial example ?
These few lines of code fail with
perl codesnippets/accessor.pl
Can't locate object method "color" via package "Critter" at
codesnippets/accessor.pl line 6.
see the code:
#!/opt/local/bin/perl
# The whole Class::Accessor thing does not work !!
my $a = Critter->new;
$a->color("blue");
$a->display;
exit 0;
package Critter;
use base qw(Class::Accessor );
Critter->mk_accessors ("color" );
sub display {
my $self = shift;
print "i am a $self->color " . ref($self) . ", whatever this word means\n";
}
Your code is out of order. If you want the color accessor to be available, you need to invoke mk_accessors before you create your object and start doing stuff with it. For example:
package Critter;
use base qw(Class::Accessor);
Critter->mk_accessors("color");
sub display {
my $self = shift;
print $self->color, ' ', ref($self), "\n";
}
package main;
my $c = Critter->new;
$c->color("blue");
$c->display;
More commonly, the Critter code would be in its own module (Critter.pm), and all of the mk_accessor magic would happen when your main script runs use Critter -- well before your script starts working with Critter and Varmint objects.
FM is giving you good advice. mk_accessors needs to run before the other code. Also, normally you'd put Critter in a separate file and use Critter to load the module.
This works because use has compile time effects. Doing use Critter; is the same as doing BEGIN { require Critter; Critter->import; } This guarantees that your module's initialization code will run before the rest of the code even compiles.
It is acceptable to put multiple packages in one file. Often, I will prototype related objects in one file, since it keeps everything handy while I am prototyping. It's also pretty easy to split the file up into separate bits when the time comes.
Because of this, I find that the best way to keep multiple packages in one file, and work with them as if I were using them, is to put the package definitions in BEGIN blocks that end in a true value. Using my approach, your example would be written:
#!/opt/local/bin/perl
my $a = Critter->new;
$a->color("blue");
$a->display;
BEGIN {
package Critter;
use base qw(Class::Accessor );
use strict;
use warnings;
Critter->mk_accessors ("color" );
sub display {
my $self = shift;
# Your print was incorrect - one way:
printf "i am a %s %s whatever this word means\n", $self->color, ref $self;
# another:
print "i am a ", $self->color, ref $self, "whatever this word means\n";
}
1;
}
I just wanted to provide you with a better solution -- feel free to downvote this to oblivion if the solution isn't welcome, but C::A is really a bad idea this day and age, use Moose:
package Critter;
use Moose;
has 'color' => ( isa => 'Str', is => 'rw' ); # Notice, this is typed
sub display {
my $self = shift;
printf (
"i am a %s %s whatever this word means\n"
, $self->color
, $self->meta->name
);
}
package main;
use strict;
use warnings;
my $c = Critter->new; # or my $c = Critter->new({ color => blue });
$c->color("blue");
$c->display;