What is the domain of a reference function called in a perl module? - perl

I would like to pass function reference to a perl module as follows.
Here is the main program:
#main.pl
use module;
my $ref = sub {
# what if a function is called or an array asked?
# is domain main:: or module::?
print "Log $date ", #_, "\n"
} ;
define_log_function($ref);
And here is the module:
# module.pm
package module;
my $log ;
sub define_log_function {
$log = shift;
}
sub other_function {
$log and &$log("Calling other_function");
(...)
}
What is the domain of the log function called inside my module? What happens if I try to call a function inside my module? Is its domain "main::" or "module::"?
Thank for your time.

Every subroutine belongs to a certain package, even when it's an anonymous sub. The following code will print Foo Foo:
use feature 'say';
package Foo;
my $coderef = sub {
say __PACKAGE__;
foo();
};
sub foo { say "Foo" }
package Bar;
sub foo { say "Bar" }
$coderef->();
It doesn't matter that the $coderef is executed inside the Bar package because it was compiled inside the Foo package. Not only subroutines, but also other global variables are looked up in the package where the code was compiled in.
Note that you can switch into another package whenever you want, for the rest of the lexical scope:
my $coderef = sub {
say __PACKAGE__;
package Bar;
foo();
};
would give Foo Bar.

$ref lexical variable (defined with my) and holds reference to closure. Lexicals doesn't belong to namespace, only global variables can be accessed like $module::package_global.

Related

How to not export all functions/methods from a package in perl?

I am playing around with a existing perl module lets call it Obj.
I have added some new features (subroutines / methods) to Obj but store them in another .pm call it Foo. However I dont want Obj to inherit every sub from Foo.
Now I have been reading perl documentation for a few hours and am confused.
https://perldoc.perl.org/Exporter#Selecting-What-to-Export
Just says 'Do not export method names!'
Here is some example code, I'd like to not see sub _not_exported from Obj.pm:
#!/usr/bin/env perl
use strict;
use warnings;
use diagnostics;
package Foo;# Foo is a new PM file used to extend Obj with collections of subroutine's.
# I want to use hello() from Obj
#use Exporter 'import';
use Exporter qw(import);
our #EXPORT_OK = qw/hello/;
sub hello {
my $self = shift;
$self->{test} = 'Hello world';
}
# I'd rather not pollute Obj with this sub
# or perfreably all subs the begin with a underscore
# How do I exclude this sub?
sub _not_exported {
my $self = shift;
return 'Exported';
}
#main old code object module
package Obj; # large old PM file I dont want to change this file much
# pull in the new module
use base 'Foo';
# use base seems better than this:
#import Foo;
#our #ISA = qw(Foo);
sub new {
my $self = {};
bless $self, 'Obj';
return $self;
}
eval { $this = $form->_not_exported() } ; #Should return nothing
sub catch_hash {
my ($self,$arg) = #_;
$arg |= '';
$self->{test} = 'catch';
}
#Perl script, creates an object using Obj;
package main;
#use Obj;
import Obj;
my $form = Obj->new();
$form->catch_hash();
print "Toss? '$form->{test}' \n";
$form->hello();
print "\nHello? '$form->{test}'\n";
my $this = "";
eval { $this = $form->_not_exported() } ; #Should return nothing
print "$this\ndone\n";
1;
I am open to other options like Moo / Moose but dont want to change the old code much.
Thanks in advance
[Note: I'm am a former maintainer of Exporter]
I believe you've confused exporting with inheritance. That's easy to do, Perl doesn't draw a line between "function" and "method", they're just sub.
tl;dr You don't need to export, that's just how inheritance works, there is a work around.
Exporting lets you call a function from outside of a package without fully qualifying it. It would let you call Foo::hello as just hello. Exporting lets Perl know that hello really means hello in package Foo.
But these are method calls, and you call them on a class or object. my $foo = Foo->new; $foo->hello. No exporting required. Foo->new calls new in Foo and returns a Foo object. $foo->hello knows to look for the method foo in the ancestry of $foo's class. You don't need to use exporter in a class, that's what "Do not export method names" means.
Exporting is a deliberate act which copies symbols around. Inheritance is all or nothing. If you inherit from a class you get all its methods (subs). This is a consequence of inheritance, and there are many other alternatives to inheritance such as composition.
In other OO languages you could declare the method private and it would not be inherited. Perl doesn't have that. Normally you just live with this by convention as you have, put an underscore in front of the method name, don't document it, and if somebody uses it that's their problem. And that's usually fine.
But you can make truly private methods with anonymous subs and lexical variables.
package Foo;
# Define `new` in Foo. Obj will inherit it.
# Do not hard code the class.
# `new` receives the class new was called on.
sub new {
my $class = shift;
return bless {}, $class;
}
sub hello {
my $self = shift;
$self->{test} = 'Hello world';
}
# This is a reference to an anonymous function in a lexical variable.
# It can only be seen by the code after this line in this file.
my $private_method = sub {
my $self = shift;
return "private method called by $self with args: #_\n";
};
sub public_method {
my $self = shift;
# $private_method can be seen here.
# A subroutine reference can be called like a method.
print $self->$private_method("basset hounds got long ears");
}
And in Obj.pm
package Obj;
# parent is a lightweight replacement for base.
use parent 'Foo';
Obj inherits new and hello and public_method from Foo, but it cannot see $private_method. It can only be seen inside Foo.pm.
my $obj = Obj->new;
# private method called by Obj=HASH(0x7fcfdb8126d8) with args: basset hounds got long ears
$obj->public_method;
Because public_method is defined where it can see $private_method, $obj->public_method will work despite being called on an instance of Obj and not Foo.

How can I apply a Moose method modifier to a method based on a method attribute?

I want to apply a Moose 'before' method modifier to a number of methods in my class. I want to provide the modifier method in a role. I can do it a bit like this:
package MyApp::Role;
use Moose::Role
before [qw(foo bar)] => sub {
...
};
package MyApp;
use Moose;
with (MyApp::Role);
sub foo { ... }
sub bar { ... }
sub baz { ... } # this method is unaffected
However, having to maintain the list of relevant methods in the role ties it to the consuming class and that just seems wrong. I would like to do it a smarter way, like with method attributes:
package MyApp;
use Moose;
with (MyApp::Role);
sub foo :SomeFlag { ... }
sub bar :SomeFlag { ... }
sub baz { ... } # this method is unaffected
I'm not familiar with how to identify method attributes or how I would dynamically apply method modifiers to them.
Or, maybe there is a better way of doing this?
Let's use Attribute::Handlers for this – a fairly sane way to use attributes. We must define a function in a base class which itself has the attribute :ATTR(CODE). This takes a number of arguments:
The package where the sub (or other variable) comes from.
A globref, or the string ANON.
A reference to the value (here: coderef).
The name of the attribute.
Optional data for the attribute.
The (compilation) phase where the attribute was invoked.
The filename where the sub was declared.
The line number where the sub was declared.
So what we can do is to write a handler that applies a before:
use strict; use warnings; use feature 'say';
BEGIN {
package MyRole;
use Moose::Role;
use Attribute::Handlers;
sub SomeFlag :ATTR(CODE) {
my ($package, $globref, $code, $attr, $data, $phase, $filename, $line) = #_;
ref($globref) eq 'GLOB'
or die "Only global subroutines can be decorated with :SomeFlag"
. " at $filename line $line.\n";
# use the MOP to install the method modifier
$package->meta->add_before_method_modifier(
*$globref{NAME} => sub {
warn "Just about to call a flagged sub!";
},
);
}
}
BEGIN {
package MyApp;
use Moose;
# important: SomeFlag must be available before the attrs are handled (CHECK phase)
BEGIN { with 'MyRole' };
sub foo :SomeFlag { say "Hi from foo sub!" }
sub bar :SomeFlag { say "Hi from bar sub!" }
sub baz { say "Hi from baz sub!" }
}
package main;
my $o = MyApp->new;
$o->$_ for qw/foo bar baz/;
I stuffed all of this into a single file, but that obviously isn't neccessary (just add the required uses).
Output:
Just about to call a flagged sub! at so.pl line 16.
Hi from foo sub!
Just about to call a flagged sub! at so.pl line 16.
Hi from bar sub!
Hi from baz sub!

Can a function tell which module it was called from?

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)

How does the Perl 'use' syntax work?

Sample code:
m1.pm
my $a;
my $b;
sub init {
$a = shift;
$b = shift;
}
sub printab {
print "a = -$a-\n";
print "b = -$b-\n";
}
1;
m2.pm
my $a;
my $b;
sub init {
$a = shift;
$b = shift;
}
1;
test.pl
use strict;
use warnings;
use m1;
use m2;
init('hello', 'world');
printab();
Run:
$ perl test.pl
a = --
b = --
$
What happens is that the init('hello', 'world') call is mapped to m2.pm and initializes the variables ($a and $b) there.
This kind of makes sense, but what I do not understand is why those values are not available in test.pl.
Is there something fundamentally wrong that I am trying to do here? What is the correct way to use two modules with same named subroutines and variables?
How exactly does a Perl use work? It would help if someone could contrast it with C's #include directive.
In Perl, the use keyword is exactly equivalent to the following:
use Mymodule;
#is the same as
BEGIN {
require Mymodule;
Mymodule->import();
}
So if you are not defining an import routine in your code (or inheriting from Exporter), then your modules are not importing anything into test.pl
As Sinan caught, you are not declaring a package in your modules, so they are defaulting to the main package. In that case, all of your subroutines are in main, but the lexical variables (declared with my) are only scoped to the file they are declared in.
So m1 defines sub init and sub printab to which the lexicals $a and $b are in scope. But then when test.pl loads m2, the init routine is overwritten with the new definition, which is not closed around the two lexicals anymore. So it is writing to the package variables $main::a and $main::b instead of the lexicals which printab is bound to.
If you had warnings enabled (which you always should when learning), you would have been warned about the subroutine redefinition.
You should start each of your modules with:
package Some::Package::Name;
use warnings;
use strict;
and then end each module with:
1;
This is because when you use/require a module, it needs to return a true value at the end so that Perl knows it loaded properly.
First, do read perldoc perlmod.
You do not declare a namespace in either module, so everything is in the main namespace. Declare package m1; in m1.pm and package m2; in m2.pm.
At the very least, you should implement an import method (or inherit the one Exporter provides) so that programs that use modules can decide what to import from where.
It also seems to me that you are exploring around the edges of OO.
Further:
Avoid using $a and $b as variable names because it is easy to confuse them with the package variables $a and $b used by sort.
Don't use lower case module names: They are reserved for pragmata.
A minimal implementation (all in one file for testing convenience) looks like this:
package My::M1;
use strict; use warnings;
sub new { my $class = shift; bless { #_ } => $class }
sub a {
my $self = shift;
my ($v) = #_;
$self->{a} = $v if #_;
return $self->{a};
}
sub b {
my $self = shift;
my ($v) = #_;
$self->{b} = $v if #_;
return $self->{b};
}
package My::M2;
use strict; use warnings;
use base 'My::M1';
sub printtab {
my $self = shift;
for my $x (qw(a b)) {
printf "%s = -%s-\n", $x, $self->$x;
}
}
package main;
my $m = My::M2->new(a => 'hello', 'b' => 'world');
$m->printtab;
printab() is defined in the file m1.pm and only has access to the $a and $b variables that are scoped to that file. The variables $a and $b in m2.pm are scoped to that file, and they are different variables than the $a and $b in m1.pm.
init() sets the variables scoped in m2.pm (because that's the last place the &init function was defined) so it is not setting the same variables that printab() will be trying to print.

How does an object access the symbol table for the current package?

How could I access the symbol table for the current package an object was instantiated in? For example, I have something like this:
my $object = MyModule->new;
# this looks in the current package, to see if there's a function named run_me
# I'd like to know how to do this without passing a sub reference
$object->do_your_job;
If in the implementation of do_your_job I use __PACKAGE__, it will search in the MyModule package. How could I make it look in the right package?
EDIT:I'll try to make this clearer. Suppose I have the following code:
package MyMod;
sub new {
return bless {},$_[0]
}
sub do_your_job {
my $self = shift;
# of course find_package_of is fictional here
# just for this example's sake, $pkg should be main
my $pkg = find_package_of($self);
if(defined &{ $pkg . '::run_me' }) {
# the function exists, call it.
}
}
package main;
sub run_me {
print "x should run me.\n";
}
my $x = MyMod->new;
# this should find the run_me sub in the current package and invoke it.
$x->do_your_job;
Now, $x should somehow notice that main is the current package, and search it's symbol table. I tried using Scalar::Util's blessed , but it still gave me MyModule instead of main. Hopefully, this is a bit clearer now.
You just want caller
caller tells you the package from which it was called. (Here I added some standard perl.)
use Symbol qw<qualify_to_ref>;
#...
my $pkg = caller;
my $symb = qualify_to_ref( 'run_me', $pkg );
my $run_me = *{$symb}{CODE};
$run_me->() if defined $run_me;
To look it up and see if it's defined and then look it up to call it would duplicate it as standard perl doesn't do Common Subexpression Elimination, so you might as well 1) retrieve it, and 2) check definedness of the slot, and 3) run it if it is defined.
Now if you create an object in one package and use it in another, that's not going to be too much help. You would probably need to add an additional field like 'owning_package' in the constructor.
package MyMod;
#...
sub new {
#...
$self->{owning_package} = caller || 'main';
#...
}
Now $x->{owning_package} will contain 'main'.
See perldoc -f caller:
#!/usr/bin/perl
package A;
use strict; use warnings;
sub do_your_job {
my ($self) = #_;
my ($pkg) = caller;
if ( my $sub = $pkg->can('run_me') ) {
$sub->();
}
}
package B;
use strict; use warnings;
sub test {
A->do_your_job;
}
sub run_me {
print "No, you can't!\n";
}
package main;
use strict; use warnings;
B->test;
Output:
C:\Temp> h
No, you can't!