In Perl we can get the name of the current package and current line number Using the predefined variables like __PACKAGE__ and __LINE__.
Like this I want to get the name of the current subroutine:
use strict;
use warnings;
print __PACKAGE__;
sub test()
{
print __LINE__;
}
&test();
In the above code I want to get the name of the subroutine inside the function test.
Use the caller() function:
my $sub_name = (caller(0))[3];
This will give you the name of the current subroutine, including its package (e.g. 'main::test'). Closures return names like 'main::__ANON__'and in eval it will be '(eval)'.
caller is the right way to do at #eugene pointed out if you want to do this inside the subroutine.
If you want another piece of your program to be able to identify the package and name information for a coderef, use Sub::Identify.
Incidentally, looking at
sub test()
{
print __LINE__;
}
&test();
there are a few important points to mention: First, don't use prototypes unless you are trying to mimic builtins. Second, don't use & when invoking a subroutine unless you specifically need the effects it provides.
Therefore, that snippet is better written as:
sub test
{
print __LINE__;
}
test();
I was just looking for an answer to this question as well, I found caller as well, but I was not interested in the fully qualified path, simply the literal current package name of the sub, so I used:
my $current_sub = (split(/::/,(caller(0))[3]))[-1];
Seems to work perfectly, just adding it in for if anyone else trips over this questions :)
There special __SUB__ exists from perl-5.16.
use v5.16;
use Sub::Identify qw/sub_fullname/;
sub foo {
print sub_fullname( __SUB__ ); # main::foo
}
foo();
Actually you can pass to sub_fullname any subroutine reference (even anonymous):
use Sub::Identify qw/sub_fullname/;
sub foo {
print sub_fullname( \&foo ); # main::foo
print sub_fullname( sub{} ); # main::__ANON__
}
foo();
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 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
I'm trying to create a module with a method that receives a subroutine and redefines it. I had no problem redefining a subroutine inside the main script but the same syntax doesn't seem to work inside the method:
main.pl
use strict;
use warnings;
use ReDef;
sub orig{
print "Original!\n";
}
orig;
*orig=sub{print "not Original!\n";};
orig;
ReDef::redef(\&orig);
orig;
ReDef.pm
package ReDef;
use strict;
use warnings;
sub redef {
my $ref=shift;
*ref = sub {print "Redefined!";}
}
1;
Test output:
perl main.pl
Original!
Subroutine main::orig redefined at main.pl line 9.
not Original!
not Original!
ReDef::redef() doesn't redefine. The way I see it, the *ref is a coderef and assigning to it another subroutine should change main::orig();
What is the correct syntax?
Your redef function should be like this:
package ReDef;
use strict;
use warnings;
sub redef {
my $ref = shift;
no warnings qw(redefine);
*$ref = sub { print "Redefined!" };
}
And you should NOT call it like this:
ReDef::redef(\&orig);
Instead, you must call it like this:
ReDef::redef(\*orig);
Why? When you call orig, you're looking up the name "orig" via the symbol table, so the redef function needs to be altering the symbol table, so that it can point that name to a different bit of code. Globrefs are basically pointers to little bits of symbol table, so that's what you need to pass to ReDef::redef.
As an analogy, imagine that when you want to know the date of the Battle of Lewes, your procedure is to go to the library, look in the catalogue for the shelf address of a book on 13th century English battles, go to that shelf, and look up the date... voila 14 May 1264! Now, imagine I want to feed you altered information. Simply defining a new coderef would be like putting a new book on the shelf: it won't trick you because the catalogue is still pointing you at the old book. We need to alter the catalogue too.
UPDATE
You can make this a little prettier using prototypes. Prototypes are not usually recommended, but this seems to be a non-evil use for them...
use strict;
use warnings;
sub ReDef::redef (*) {
my $ref = shift;
no warnings qw(redefine);
*$ref = sub { print "Redefined!\n" };
}
sub orig { print "Original!\n" }
orig;
ReDef::redef *orig; # don't need the backslash any more
orig;
This works for me:
use v5.16;
use strict;
use warnings;
package Redef;
sub redef {
my $ref = shift;
${$ref} = sub { say "Redefined!"; }
}
package main;
my $orig = sub { say "Original!"; };
Redef::redef(\$orig);
$orig->(); # Redefined!
Although it’s just a result of trial and error, I’d be happy to see better answers.
What maybe got you confused is the typeglob operator, *. In Perl you dereference using a sigil (${$scalar_ref}, #{$array_ref}) and the * operator is used for symbol table tricks – which could also be used in your case, see the answer by #tobyink.
package Bar;
use Foo;
sub bar { fooit "hello from bar"; }
package Foo;
sub fooit {
# Somehow I want this function to know it was called
# from the "Bar" module (in this case).
}
Preferably, this would be done without explicitly passing an argument containing the calling module's name.
The builtin caller function can be used to get information about the current call stack.
sub fooit {
my ($pkg, $file, $line) = caller;
print STDERR "fooit was called from the $pkg package, $file:$line\n";
}
caller with no argument in scalar context will return the caller's namespace.
my $caller = caller();
or
print caller()."\n"; # '.' forces scalar context
or
print "".caller(), "\n"; # '.' forces scalar context
It's very rare that you need that, unless you're trying to replicate the behaviour of one of Carp's subs.
Using the builtin caller should be the easiest and the most straightforward way to do this, but Devel::Backtrace is also a worth to see CPAN module, which can provide more detail information with an elegant interface.
package Foo;
use Devel::Backtrace;
sub fooit {
my $backtrace = Devel::Backtrace->new;
print $backtrace->point(1)->package, "\n\n";
print $backtrace;
}
package Bar;
sub bar {
Foo::fooit('hello from bar');
}
package main;
Bar::bar();
Output:
Bar
Devel::Backtrace::new called from Foo (test.pl:5)
Foo::fooit called from Bar (test.pl:14)
Bar::bar called from main (test.pl:19)
Given a variable containing a string that represents the name of a package, how do I call a specific subroutine of the package?
Here's the closest thing I have figured out:
package MyPackage;
sub echo {
print shift;
}
my $package_name = 'MyPackage';
$package_name->echo('Hello World');
1;
The problem with this code is the subroutine is called as a class method; the package name is passed in as the first argument. I want to invoke the subroutine from the package name without a special first argument being implicitly passed in.
It sounds like you don't want to actually call it as a method, but as a regular subroutine. In that case, you can use a symbolic reference:
my $package_name = 'MyPackage';
{
no strict 'refs';
&{ $package_name . '::echo' }( 'Hello World' );
}
Perl method calls are just regular subroutines, which get the invocant as the first value.
use strict;
use warnings;
use 5.10.1;
{
package MyPackage;
sub new{ bless {}, shift } # overly simplistic constructor (DO NOT REUSE)
sub echo{ say #_ }
}
my $package_name = 'MyPackage';
$package_name->echo;
my $object = $package_name->new();
$object->echo; # effectively the same as MyPackage::echo($object)
MyPackage
MyPackage=HASH(0x1e2a070)
If you want to call a subroutine without an invocant, you will need to call it differently.
{
no strict 'refs';
${$package_name.'::'}{echo}->('Hello World');
&{$package_name.'::echo'}('Hello World');
}
# only works for packages without :: in the name
$::{$package_name.'::'}{echo}->('Hello World');
$package_name->can('echo')->('Hello World');
The can method returns a reference to the subroutine that would be called if it had been called on the invocant. The coderef can then be used separately.
my $code_ref = $package_name->can('echo');
$code_ref->('Hello World');
There are some caveats to using can:
can may be overridden by the package, or any class from which it inherits.
The package that defines a method may be different than the invocant.
This may actually be the behaviour you're looking for though.
Another approach is to use something called a symbolic reference.
{
no strict 'refs';
&{ $package_name.'::echo' }('Hello World');
}
Using symbolic references is usually not recommended. Part of the problem is that it is possible to accidently use a symbolic reference where you didn't intend on using one. This is why you can't have use strict 'refs'; in effect.
This may be the simplest way to do what you want to do though.
If you don't want to use a symbolic reference you could use the Stash.
$MyPackage::{echo}->('Hello World');
$::{'MyPackage::'}{echo}->('Hello World');
$main::{'MyPackage::'}{echo}->('Hello World');
$main::{'main::'}{'MyPackage::'}{echo}->('Hello World');
$main::{'main::'}{'main::'}{'main::'}{'MyPackage::'}{echo}->('Hello World');
The only problem with this is that you would have to split $package_name on ::
*Some::Long::Package::Name::echo = \&MyPackage::echo;
$::{'Some::'}{'Long::'}{'Package::'}{'Name::'}{echo}('Hello World');
sub get_package_stash{
my $package = shift.'::';
my #package = split /(?<=::)/, $package;
my $stash = \%:: ;
$stash = $stash->{$_} for #package;
return $stash;
}
get_package_stash('Some::Long::Package::Name')->{echo}('Hello World');
This isn't that big of a problem though. After a quick look on CPAN you find Package::Stash.
use Package::Stash;
my $stash = Package::Stash->new($package_name);
my $coderef = $stash->get_symbol('&echo');
$coderef->('Hello World');
(The Pure Perl version of Package::Stash uses symbolic references, not the Stash)
It's even possible to make an alias of the subroutine/method, as if had been imported from a module that was using Exporter:
*echo = \&{$package_name.'::echo'};
echo('Hello World');
I would recommend limiting the scope of the alias though:
{
local *echo = \&{$package_name.'::echo'};
echo('Hello World');
}
This is an exception, where you can use a symbolic reference with strict 'refs' enabled.
Use the &{ <EXPRESSION> }() syntax of calling a sub whose name is the expression, as discussed in perldoc perlref when listing dereferencing operators:
Admittedly, it's a little silly to use the curlies in this case, but the BLOCK can contain any arbitrary expression, in particular, subscripted expressions:
&{ $dispatch{$index} }(1,2,3); # call correct routine
Random practical example:
# Note no "use strict"!
use File::Slurp;
my $p="File::Slurp";
#a=&{"${p}::read_file"}(".profile");
print $a[0];