refering back to this thread, I'm strugglying with the way how to export datas from my module. One way is working but not the other one which I would like to implement.
The question is why the second method in the script is not working ?
(I did not h2xs the module as I guess this is for distributing only)
Perl 5.10/ Linux distro
Module my_common_declarations.pm
#!/usr/bin/perl -w
package my_common_declarations;
use strict;
use warnings;
use parent qw(Exporter);
our #EXPORT_OK = qw(debugme);
# local datas
my ( $tmp, $exec_mode, $DEBUGME );
my %debug_hash = ( true => 1, TRUE => 1, false => 0, FALSE => 0, tmp=>$tmp, exec=>$exec_mode, debugme=>$DEBUGME );
# exported hash
sub debugme {
return %debug_hash;
}
1;
Script
#!/usr/bin/perl -w
use strict;
use warnings;
use my_common_declarations qw(debugme);
# 1st Method: WORKS
my %local_hash = &debugme;
print "\n1st method:\nTRUE: ". $local_hash{true}. " ou : " . $local_hash{TRUE} , "\n";
# 2nd Method: CAVEATS
# error returned : "Global symbol "%debug_hash" requires explicit package name"
print "2nd method \n " . $debug_hash{true};
__END__
Thx in advance.
You’re returning not a hash but rather a copy of the hash. All hashes passed into or out of a function get dehashed into a key-value pairlist. Hence, a copy.
Return a reference to the hash instead:
return \%debug_hash;
But this reveals your internals to the world outside. Not a very clean thing to do.
You could also add %debug_hash to your #EXPORT list, but that’s an even dodgier thing to do. Please please please use a functional interface only, and you won’t regret it — and more importantly, neither shall anyone else. :)
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've got a Perl script that I'm trying to make compatible with two different Perl environments. To work around the two different versions of Socket I have, I'm doing a little hackery with require and import. I've got it working, but I'm not happy with the behavior.
Mod.pm:
package Mod;
use base 'Exporter';
our #EXPORT = qw( MAGIC_CONST );
sub MAGIC_CONST() { 42; }
test.pl:
use Mod;
#require Mod;
#import Mod;
printf "MAGIC_CONST = ". MAGIC_CONST ."\n";
printf "MAGIC_CONST = ". MAGIC_CONST() ."\n";
Outputs:
MAGIC_CONST = 42
MAGIC_CONST = 42
But using the 'require' and 'import' instead, I get this:
Output:
MAGIC_CONST = MAGIC_CONST
MAGIC_CONST = 42
So the question is: Is there a clean way I can get the normal behavior of the constants? I can certainly do sub MAGIC_CONST { Mod::MAGIC_CONST(); } but that's pretty ugly.
What I'm actually doing is something like this:
use Socket;
if ($Socket::VERSION > 1.96) {
import Socket qw(SO_KEEPALIVE); # among others
setsockopt($s, SOL_SOCKET, SO_KEEPALIVE); # among others
}
The reason the require version prints MAGIC_CONST instead of 42 is because use is what tells perl to import the symbols from one module to another. Without the use, there is no function called MAGIC_CONST defined, so perl interprets it as a string instead. You should use strict to disable the automatic conversion of barewords like that into strings.
#!/usr/bin/env perl
no strict;
# forgot to define constant MAGIC_CONST...
print 'Not strict:' . MAGIC_CONST . "\n";
produces
Not strict:MAGIC_CONST
But
#!/usr/bin/env perl
use strict;
# forgot to define constant MAGIC_CONST...
print 'Strict:' . MAGIC_CONST . "\n";
Produces an error:
Bareword "MAGIC_CONST" not allowed while "strict subs" in use at
./test.pl line 4. Execution of ./test.pl aborted due to compilation
errors.
So if you want to use one module's functions in another, you either have to import them with use, or call them with the full package name:
package Foo;
sub MAGIC_CONST { 42 };
package Bar;
print 'Foo from Bar: ' . Foo::MAGIC_CONST . "\n";
Foo from Bar: 42
It's usually best to avoid conditionally importing things. You could resolve your problem as follows:
use Socket;
if ($Socket::VERSION > 1.96) {
setsockopt($s, SOL_SOCKET, Socket::SO_KEEPALIVE);
}
If you truly want to import, you still need to do it at compile-time.
use Socket;
use constant qw( );
BEGIN {
if ($Socket::VERSION > 1.96) {
Socket->import(qw( SO_KEEPALIVE ));
} else {
constant->import({ SO_KEEPALIVE => undef });
}
}
setsockopt($s, SOL_SOCKET, SO_KEEPALIVE) if defined(SO_KEEPALIVE);
Adam's answer gives a good explanation of what is going on and how to get the desired behavior. I am going to recommend not using constant.pm to define symbolic names for constants. A fairly nice looking and convenient alternative with fewer gotchas is to use constants defined using Const::Fast and allow them to be imported.
In addition, by using Importer in the module which wants to import the constants, the module that defines the constants can avoid inheriting Exporter's heavy baggage, or having to use Exporter's import.
The fact that Const::Fast allows you to define real constant arrays and hashes is a bonus.
For example:
package MyConstants;
use strict;
use warnings;
use Const::Fast;
use Socket;
const our #EXPORT => ();
const our #EXPORT_OK => qw(
%SOCKET_OPT
);
const our %SOCKET_OPT => (
keep_alive => ($Socket::VERSION > 1.96) ? Socket::SO_KEEPALIVE : undef,
);
__PACKAGE__;
__END__
Using these constants in a script:
#!/usr/bin/env perl
use strict;
use warnings;
use Socket;
use Importer 'MyConstants' => qw( %SOCKET_OPT );
if ( defined $SOCKET_OPT{keep_alive} ) {
setsockopt($s, SOL_SOCKET, $SOCKET_OPT{keep_alive});
}
As I note in my blog post:
f I want to read the constants from a configuration file, that's trivial. If I want to export them to JSON, YAML, INI, or whatever else, that's also trivial. I can interpolate them willy-nilly.
For those who have taken seriously Exporter's stance against exporting variables, this takes some getting used to. Keep in mind that the admonition is there to make sure you don't write code that willy nilly modifies global variables. However, in this case, the variables we are exporting are not modifiable. Maybe you can convince yourself that the concern really does not apply in this instance. If you try to refer to a non-existent constant, you get an error (albeit during run time) ...
In most cases, the benefits of this approach outweigh the speed penalty of not using constant.pm.
use Dancer2;
use List::Util qw(any);
sub use_any_subroutine {
foreach my $foo (#$foo_array) {
next unless any { $_ == $foo->id } #hello_world;
}
return;
}
there is a conflict with using List::Util and throwing a warning
Prototype mismatch: sub main::any: none vs (&#) at Exporter.pm(...).
i found a solution that is we can use List::Util::any instead of importing it before use,but i want to import it once,so how to avoid this warning
Thanks very much for comments.
There are a few possible solutions
Note that I'm using the core List::Util module here, because it also contains an any function, and shouldn't need installing on most recent releases of perl
As you have said yourself, you could fully-qualify the subroutine instead of importing it, and use List::Util::any
You could disable the import of any from Dancer2 by using
use Dancer2 '!any'
which will work as long as you never need Dancer2's any to write your code
You could also use first instead of any from List::Util, which returns the first element of the list for which the block returns a true value, and will work fine as long as everything in your list is true
Another alternative is to import any from List::Util with a different name
BEGIN {
require List::Util;
*my_any = \&List::Util::any;
}
and now you have a subroutine my_any that behaves exactly as the original any from List::Util but doesn't clash with the operator of the same name from Dancer2
Both Dancer2 and List::MoreUtils export an any function into your namespace.
For Dancer2, it's part of its DSL and is used as a route definition that matches any HTTP verb on incoming requests.
Defines a route for multiple HTTP methods at once
The List::MoreUtils one is like a grep instead.
Returns a true value if any item in LIST meets the criterion given through BLOCK.
The warning you are seeing is because you have imported the Dancer2 one first, so Perl learned about the prototype of that one. Then you imported the one from List::MoreUtils, which overwrote &main::any in your namespace main::, but the prototype is still there.
You can avoid importing any from Dancer2.
use Dancer2 qw( !any );
use List::MoreUtils qw( any );
get '/' => sub {
my #foo = ( 1, 2, 3 );
return List::MoreUtils::any { $_ == 2 } #foo;
};
dance;
Or you can avoid importing any from List::MoreUtils (using List::MoreUtils::any instead of any).
use Dancer2;
use List::MoreUtils qw( );
get '/' => sub {
my #foo = ( 1, 2, 3 );
return List::MoreUtils::any { $_ == 2 } #foo;
};
dance;
It is impossible to be sure without seeing more of your program, but at a guess, you have declared your own subroutine sub any as well as trying to import it from List::MoreUtils.
You need only the use statement.
I'd like to setup Config::General to read from the __DATA__ section of a script instead of an external file. (I realize that's not normally how it works, but I'd like to see if I can get it going. A specific use case is so I can send a script example to another developer without having to send a separate config file.)
According to the perldoc perldata, $main::DATA should act as a valid filehandle. I think Config::General should then be able to use -ConfigFile => \$FileHandle to read it, but it's not working for me. For example, this script will execute without crashing, but the __DATA__ isn't read in.
#!/usr/bin/perl -w
use strict;
use Config::General;
use YAML::XS;
my $configObj = new Config::General(-ConfigFile => $main::DATA);
my %config_hash = $configObj->getall;
print Dump \%config_hash;
__DATA__
testKey = testValue
I also tried:
my $configObj = new Config::General(-ConfigFile => \$main::DATA);
and
my $configObj = new Config::General(-ConfigFile => *main::DATA);
and a few other variations, but couldn't get anything to work.
Is it possible to use Config::General to read config key/values from __DATA__?
-ConfigFile requires a reference to a handle. This works:
my $configObj = Config::General->new(
-ConfigFile => \*main::DATA
);
The DATA handle is a glob, not a scalar.
Try *main::DATA instead of $main::DATA.
(and maybe try \*main::DATA. From the Config::General docs it looks like you are supposed to pass a filehandle argument as a reference.)
If the -ConfigGeneral => filehandle argument to the constructor doesn't do what you mean, an alternative is
new Config::General( -String => join ("", <main::DATA>) );
This works for me:
#!/usr/bin/perl
use strict;
use warnings;
use Config::General;
use YAML::XS;
my $string;
{
local $/;
$string = <main::DATA>;
};
my $configObj = new Config::General(-String => $string);
my %config_hash = $configObj->getall;
use Data::Dumper;
warn Dumper(\%config_hash);
__DATA__
testKey = testValue
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;