Attempt to use #INC and call function on demand - perl

I am trying to learn how to use a .pm file. I created 2 files:
MyScript.pl
use strict;
BEGIN {
unshift(#INC,"./firstdir");
}
my #list = qw (J u s t ~ A n o t h e r ~ P e r l ~ H a c k e r !);
use seconddir::MyModule qw(func1) ;
print func1(#list),"\n"; #line 21
print MyModule::func2(#list),"\n";
MyModule.pm
package MyModule;
use strict;
use Exporter;
use vars qw($VERSION #ISA #EXPORT #EXPORT_OK %EXPORT_TAGS);
$VERSION = 1.00;
#ISA = qw(Exporter);
#EXPORT = ();
#EXPORT_OK = qw(func1 func2);
%EXPORT_TAGS = ( DEFAULT => [qw(&func1)],
Both => [qw(&func1 &func2)]);
sub func1 { return reverse #_ }
sub func2 { return map{ uc }#_ }
1;
the structure of the directories is as following:
--------------- ------------ ---------------
| firstdir ---|------> |seconddir--|-> | MyModule.pm |
| MyScript.pl | ------------ ---------------
---------------
note: firstdir and seconddir are directories
when I run the command Perl MyScript.pl I receive the following error:
Undefined subroutine &main::func1 called at MyScript.pl line 21
can you help me figure out what is wrong please?

Your package name is wrong, it should be:
package seconddir::MyModule
Then you should call func2 with:
print seconddir::MyModule::func2(#list),"\n";
or by exporting it, as with func1.

func1 should be in the #EXPORT array in the module MyModule.pm if you want to call it directly as func1 in your main script.

#EXPORT = qw(func1 func2);
You need to add the names of the symbols in the #EXPORT array in order to access them from you script.

Related

Perl Module using %EXPORT_TAGS

I'm having trouble properly using %EXPORT_TAGS in my Perl module. In Solver.pl I have:
use MatrixFunctions qw(:Normal);
Then inside MatrixFunctions.pm, I have:
package MatrixFunctions;
use strict;
use Exporter;
use vars qw($VERSION #ISA #EXPORT #EXPORT_OK %EXPORT_TAGS);
$VERSION = 1.00;
#ISA = qw(Exporter);
#EXPORT = ();
#EXPORT_OK = qw(&det &identityMatrix &matrixAdd
&matrixScalarMultiply &matrixMultiplication);
%EXPORT_TAGS = ( Det => [qw(&det)],
Normal => [qw(&det &identityMatrix &matrixAdd
&matrixScalarMultiply &matrixMultiplication)]);
However it only works when I have #EXPORT_OK including all the methods. If I have
#EXPORT_OK = ();
I have the error:
"matrixScalarMultiply" is not exported by the MatrixFunctions module
"det" is not exported by the MatrixFunctions module
"matrixAdd" is not exported by the MatrixFunctions module
"matrixMultiplication" is not exported by the MatrixFunctions module
"identityMatrix" is not exported by the MatrixFunctions module
Can't continue after import errors at Solver.pl line 6.
BEGIN failed--compilation aborted at Solver.pl line 6.
The point of using qw(:Normal) in my Solver.pl file is so that I can have #EXPORT_OK empty I thought. What am I doing wrong?
perldoc -f Exporter under the Advanced Features section:
e.g., Module.pm defines:
#EXPORT = qw(A1 A2 A3 A4 A5);
#EXPORT_OK = qw(B1 B2 B3 B4 B5);
%EXPORT_TAGS = (T1 => [qw(A1 A2 B1 B2)], T2 => [qw(A1 A2 B3 B4)]);
Note that you cannot use tags in #EXPORT or #EXPORT_OK.
Names in EXPORT_TAGS must also appear in #EXPORT or #EXPORT_OK.
The bolded section above explains that you are required to have the functions you wish to place in %EXPORT_TAGS in either #EXPORT_OK or #EXPORT
A pattern that I have started using is to defined everything that I want to allow to be exported in #EXPORT_OK, then use #EXPORT_OK to build an `:all' tag:
our #ISA = qw(Exporter);
our #EXPORT_OK = qw/raspberry apple/;
our %EXPORT_TAGS = (
'all' => \#EXPORT_OK,
);
[Not an answer, but a follow-up to large for a comment]
If you want #EXPORT_OK automatically populated, you can use the following:
push #EXPORTER_OK, map #$_, values %EXPORT_TAGS;
Exporter doesn't care about duplicate entries. If you do, you can use the following instead:
my %EXPORT_OK;
#EXPORT_OK = grep !$EXPORT_OK{$_}++,
#EXPORT_OK, map #$_, values %EXPORT_TAGS;
So, after some cleaning up, your code would be the following:
package MatrixFunctions;
use strict;
use warnings;
use Exporter qw( import );
our $VERSION = 1.00;
our #EXPORT = ();
our #EXPORT_OK = ();
our %EXPORT_TAGS = (
Det => [qw( det )],
Normal => [qw( det identityMatrix matrixAdd matrixScalarMultiply matrixMultiplication )],
);
push #EXPORTER_OK, map #$_, values %EXPORT_TAGS;

Properly Use this Perl Module

I've looked at several examples of using a Perl module and I still can't get it right. I'm following this tutorial: http://www.perlmonks.org/?node_id=102347. For the following .pl and .pm files, I call
$ perl Solver.pl
and have the below error.
Undefined subroutine &main::mergeSort called at Solver.pl line 13.
Solver.pl
#!/usr/bin/perl
#Program usage: perl PROGRAM
#example:
#perl solver.pl
use strict;
use warnings;
use MergeSort qw(:DEFAULT);
### MAIN ###
mergeSort(\#list); #ERROR;
### END MAIN ###
MergeSort.pm
package MergeSort;
use strict;
use Exporter;
use vars qw($VERSION #ISA #EXPORT #EXPORT_OK %EXPORT_TAGS);
$VERSION = 1.00;
#ISA = qw(Exporter);
#EXPORT = ();
#EXPORT_OK = qw(mergeSort);
%EXPORT_TAGS = ( DEFAULT => [qw(&mergeSort)],
Both => [qw(&mergeSort &merge)]);
sub mergeSort{
...(defined here
}#end mergeSort()
sub merge{
...(defined here)
}#end merge()
1;
:DEFAULT has a builtin definition which takes precedence over yours. It exports all the symbols that are exported by default, which is to say all the symbols in #EXPORT. You should have used:
our #EXPORT = qw( mergeSort );
our #EXPORT_OK = #EXPORT;
our %EXPORT_TAGS = ( ALL => \#EXPORT_OK );
use MergeSort; # Same as: use MergeSort qw( :DEFAULT );
But I think explicitly listing one's imports is a good idea, so I'd use
our #EXPORT = qw( );
our #EXPORT_OK = qw( mergeSort );
our %EXPORT_TAGS = ( ALL => \#EXPORT_OK );
use MergeSort qw( mergeSort );

How to detect exported subs overwrites?

Having a next code:
use strict;
use warnings;
use Devel::Peek;
use YAML;
my $s = {a=>'b'};
print Dump($s);
it prints YAML output:
---
a: b
now changing the order of the modules.
use strict;
use warnings;
use YAML;
use Devel::Peek;
my $s = {a=>'b'};
print Dump($s);
it prints:
SV = IV(0x7ff5d2829308) at 0x7ff5d2829318
REFCNT = 1
FLAGS = (PADMY,ROK)
RV = 0x7ff5d2803438
SV = PVHV(0x7ff5d2808d20) at 0x7ff5d2803438
REFCNT = 1
FLAGS = (SHAREKEYS)
ARRAY = 0x7ff5d243acf0 (0:7, 1:1)
hash quality = 100.0%
KEYS = 1
FILL = 1
MAX = 7
Elt "a" HASH = 0x274d838f
SV = PV(0x7ff5d2804070) at 0x7ff5d2828a00
REFCNT = 1
FLAGS = (POK,IsCOW,pPOK)
PV = 0x7ff5d240e2d0 "b"\0
CUR = 1
LEN = 16
COW_REFCNT = 1
Use of uninitialized value in print at yy line 8.
Both module exports a function Dump so, the last wins.
I have enabled warnings, but it doesn't warn me about the exported functions redefine (overwrite?). It is possible detect and show a warning for such redefines?
Most interesting question. The problem, I think, lies in the fact that Exporter.pm doesn't have warnings enabled. Here's a simple set of files that demonstrates the behaviour you described:
Foo.pm:
package Foo;
use base 'Exporter';
our #EXPORT = qw(Baz);
sub Baz {
print "Hello from Foo::Baz\n";
}
Bar.pm:
package Bar;
use base 'Exporter';
our #EXPORT = qw(Baz);
sub Baz {
print "Hi from Bar::Baz\n";
}
import-redefine.pl:
use strict;
use warnings;
use Foo;
use Bar;
Baz();
Sample run:
C:\Users\Lona\Desktop\pm>perl import-redefine.pl
Hi from Bar::Baz
Reverse the use statements, as follows:
use strict;
use warnings;
use Bar;
use Foo;
Baz();
And run again:
C:\Users\Lona\Desktop\pm>perl import-redefine.pl
Hello from Foo::Baz
I've come up with the following solution, that redefines Exporter.pm's default import method:
BEGIN {
require Exporter; # We'll need Exporter.pm loaded.
my $old_import = \&Exporter::import; # Save copy of original Exporter::import.
no strict 'refs'; # We'll be using some hacks that will
no warnings 'redefine'; # raise errors and warnings. Suppress those.
*Exporter::import = sub { # Our enhancement of Exporter::import.
use Carp;
my $pkg = shift;
my $callpkg = caller($Exporter::ExportLevel + 1);
my #exports = #_ > 0 # Which subs to export?
? #_ # Those provided as 'use MODULE' arguments...
: #{"$pkg\::EXPORT"} # Or thosedefined in the module's #EXPORT?
;
foreach my $sub (#exports) { # For each of the exportees...
if (exists ${"$callpkg\::"}{$sub}) { # ... check if it exists...
carp "Subroutine $callpkg\::$sub redefined by import"; # and throw a warning if needed.
}
$old_import->($pkg, #_); # Call the original Exporter::import.
}
}
}
To use this, but it somewhere in your main script file, above the use MODULE statements:
use strict;
use warnings;
BEGIN {
require Exporter; # We'll need Exporter.pm loaded.
my $old_import = \&Exporter::import; # Save copy of original Exporter::import.
no strict 'refs'; # We'll be using some hacks that will
no warnings 'redefine'; # raise errors and warnings. Suppress those.
*Exporter::import = sub { # Our enhancement of Exporter::import.
use Carp;
my $pkg = shift;
my $callpkg = caller($Exporter::ExportLevel + 1);
my #exports = #_ > 0 # Which subs to export?
? #_ # Those provided as 'use MODULE' arguments...
: #{"$pkg\::EXPORT"} # Or thosedefined in the module's #EXPORT?
;
foreach my $sub (#exports) { # For each of the exportees...
if (exists ${"$callpkg\::"}{$sub}) { # ... check if it exists...
carp "Subroutine $callpkg\::$sub redefined by import"; # and throw a warning if needed.
}
$old_import->($pkg, #_); # Call the original Exporter::import.
}
}
}
use Foo;
use Bar;
Baz();
And run it:
C:\Users\Lona\Desktop\pm>perl import-redefine.pl
Subroutine main::Baz redefined by import at import-redefine.pl line 21.
main::__ANON__("Bar") called at import-redefine.pl line 30
main::BEGIN() called at import-redefine.pl line 30
eval {...} called at import-redefine.pl line 30
Hi from Bar::Baz

access variables from different files in Perl

file1.pl
package ba;
#!/usr/bin/perl
use strict;
use warnings;
our $base_addr = 0x48;
file2.pl
package oa;
#!/usr/bin/perl
use strict;
use warnings;
our $offset_addr = 0;
file3.pl
#!/usr/bin/perl
do "file1.pl"
do "file2.pl"
my $final_val;
$final_val = $ba::base_addr + $oa::offset_addr;
printf "base_addr = 0x%0x\n", $ba::base_addr;
printf "offset_addr = 0x%0x\n", $oa::offset_addr;
printf "final addr = 0x%0x\n", $final_val;
ERRORS### ->
Argument "0x48" isn't numeric.
Use of uninitialized value.
Use of uninitialized value in addition.
Two major errors, both of which are found by using use strict; use warnings;. Always do so. (You used it in your modules, but not in your script.)
You correctly use $ba::base_addr in one spot, but then you proceeded to use non-existent variable $base_addr shortly afterwards.
You can only access $ba::base_addr as $base_addr if the current package is ba, or if you create an alias to it named $base_addr.
You either need to use $ba::base_addr consistently, or you need to export the variable to the using module. (This is one way to the alias I mentioned.)
You never assign a value to $ba::base_addr and $oa::offset_addr, so Perl gives you warnings when you attempt to add them ("not numeric") and when you try to print them ("uninitialized").
Some other problems we'll fix at the same time:
A module must return a true value, which is to say the last expression evaluated must evaluate to something true. It's thus standard to end a module with 1; (This applies to do too for reliable error detection: do $qfn or die $# || $!;.)
You should be using require instead of do since the files have a package declaration. It would be even better if you renamed them to .pm and used use.
The name of a module should match it's package declaration. If it contains package ba;, the file should be named ba.pm.
#! is only meaningful if 1) they are the first two characters of the file, and 2) if the file is provided to the OS for execution. Neither of those are the case for your modules.
ba.pm:
package ba;
use strict;
use warnings;
our $base_addr = 123;
1;
oa.pm:
package oa;
use strict;
use warnings;
our $offset_addr = 456;
1;
script.pl:
#!/usr/bin/perl
use strict;
use warnings;
use ba qw( );
use oa qw( );
my $final_val = $ba::base_addr + $oa::offset_addr;
print "base_addr = $ba::base_addr\n";
print "offset_addr = $oa::offset_addr\n";
print "final addr = $final_val\n";
You could avoid saying the package name everywhere if you exported the variables, and mentioned earlier.
ba.pm:
package ba;
use strict;
use warnings;
use Exporter qw( import );
our #EXPORT_OK = qw( $base_addr );
our $base_addr = 123;
1;
oa.pm:
package oa;
use strict;
use warnings;
use Exporter qw( import );
our #EXPORT_OK = qw( $offset_addr );
our $offset_addr = 456;
1;
script.pl:
#!/usr/bin/perl
use strict;
use warnings;
use ba qw( $base_addr );
use oa qw( $offset_addr );
my $final_val = $base_addr + $offset_addr;
print "base_addr = $base_addr\n";
print "offset_addr = $offset_addr\n";
print "final addr = $final_val\n";
It's typically bad form to export variables, though. It's usually far better to create accessors.
ba.pm:
package ba;
use strict;
use warnings;
use Exporter qw( import );
our #EXPORT_OK = qw( base_addr );
my $base_addr = 123;
sub base_addr { $base_addr }
1;
oa.pm:
package oa;
use strict;
use warnings;
use Exporter qw( import );
our #EXPORT_OK = qw( offset_addr );
my $offset_addr = 456;
sub base_addr { $base_addr }
1;
script.pl:
#!/usr/bin/perl
use strict;
use warnings;
use ba qw( base_addr );
use oa qw( offset_addr );
my $final_val = base_addr() + offset_addr();
print "base_addr = ".base_addr()."\n";
print "offset_addr = ".offset_addr()."\n";
print "final addr = $final_val\n";
You need to rename your files, add return values and include them using use. Here:
file1.pm
package ba;
use strict;
use warnings;
our $base_addr = 17;
1;
file2.pm
package oa;
use strict;
use warnings;
our $offset_addr = 19;
1;
file3.pl
#!/usr/bin/perl
use file1;
use file2;
my $final_val;
$final_val = $ba::base_addr + $oa::offset_addr;
print "base_addr = $ba::base_addr\n";
print "offset_addr = $oa::offset_addr\n";
print "final addr = $final_val\n";

Can I dynamically get a list of functions or function names from any Perl module?

I would like to dynamically get a list of either function names (as strings) or function references from any arbitrary Perl module available on my system. This would include modules that may or may not have, e.g., a global #EXPORT_OK array in its namespace. Is such a feat possible? How does one pull it off if so?
Edit: From reading perlmod, I see that %Some::Module:: serves as a symbol table for Some::Module. Is this the correct place to be looking? If so, how can I whittle the table down to just the function names in Some::Module?
You're on the right track. To wittle down the full symbol table to just the subs, something like this can be done (Hat tip "Mastering Perl", ch 8, for main package version of this):
use strict; # need to turn off refs when needed
package X;
sub x {1;};
sub y {1;};
our $y = 1;
our $z = 2;
package main;
foreach my $entry ( keys %X:: ) {
no strict 'refs';
if (defined &{"X::$entry"}) {
print "sub $entry is defined\n" ;
}
}
# OUTPUT
sub y is defined
sub x is defined
You may find this simple script handy:
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
# dump of object's symbol table:
foreach my $className (#ARGV)
{
print "symbols in $className:";
eval "require $className";
die "Can't load $className: $#" if $#;
no strict 'refs';
print Dumper(\%{"main::${className}::"});
}
But, if you're doing this in production code, I'd use Package::Stash instead:
my #subs_in_foo = Package::Stash->new('Foo')->list_all_symbols('CODE');
I'm using Perl 5.20. This works on my machine:
use strict;
package foo;
our $some_var;
sub func1 { return 'func1'}
sub func2 { return 'func2'}
package main;
sub callable {
my ($x) = #_;
return defined(&$x);
}
while (my ($k, $v) = each(%foo::)) {
if (callable($v)) {
print("$k\n");
}
}
# output:
# func1
# func2