passing parameters with perl using reflection - perl

I have the following Perl module:
package module
sub test1{
my #data=#_
print #data;
}
When I call this module from a Perl script using:
my $test='test1';
my $full_name = "Module::" . $test;
my #data=(1,2,3)
no strict 'refs';
$full_name->(#data);
I get no result on stdout but I expected 1,2,3. Could someone explain why?

It sounds like you are not setting up your module properly.
Running the following self contained script produces the correct result:
{package Module;
sub test1 {print "test1: #_\n"}
}
my $test = 'test1';
my $full_name = 'Module::'.$test;
my #data = (1, 2, 3);
no strict 'refs';
$full_name->(#data); # test1: 1 2 3
It is hard to tell without seeing exactly what you have, but chances are you have forgotten to include the package Module; line at the top of your module. The package is not implicitly set via the file name, you must declare it at the top of the file.

Related

Perl eval scope

According to perldoc, String Eval should be performed in the current scope. But the following simple test seems to contradict this.
We need the following two simple files to set up the test. Please put them under the same folder.
test_eval_scope.pm
package test_eval_scope;
use strict;
use warnings;
my %h = (a=>'b');
sub f1 {
eval 'print %h, "\n"';
# print %h, "\n"; # this would work
# my $dummy = \%h; # adding this would also work
}
1
test_eval_scope.pl
#!/usr/bin/perl
use File::Basename;
use lib dirname (__FILE__);
use test_eval_scope;
test_eval_scope::f1();
When I run the program, I got the following error
$ test_eval_scope.pl
Variable "%h" is not available at (eval 1) line 1.
My question is why the variable %h is out of scope.
I have done some modification, and found the following:
If I run without eval(), as in the above comment, it will work.
meaning that %h should be in the scope.
If I just add a seemingly useless mentioning in the code, as in the above
comment, eval() will work too.
If I combine pl and pm file into one file, eval() will work too.
If I declare %h with 'our' instead of 'my', eval() will work too.
I encountered this question when I was writing a big program which parsed user-provided code during run time. I don't need solutions as I have plenty workarounds above. But I cannot explain why the above code doesn't work. This affects my perl pride.
My perl version is v5.26.1 on linux.
Thank you for your help!
Subs only capture variables they use. Since f1 doesn't use %h, it doesn't capture it, and %h becomes inaccessible to f1 after it goes out of scope when the module finishes executing.
Any reference to the var, including one that's optimized away, causes the sub to capture the variable. As such, the following does work:
sub f1 {
%h if 0;
eval 'print %h, "\n"';
}
Demo:
$ perl -M5.010 -we'
{
my $x = "x";
sub f { eval q{$x} }
sub g { $x if 0; eval q{$x} }
}
say "f: ", f();
say "g: ", g();
'
Variable "$x" is not available at (eval 1) line 1.
Use of uninitialized value in say at -e line 8.
f:
g: x

How are these quoted strings replaced with the values in perl .pm file?

Below is the Perl code in .pm file which is supposed to replace the specified strings (that are in "quotes") with some values. But its not happening. Can anyone explain what is happening in this code?
package SomePackage;
require Exporter;
#ISA = qw(Exporter);
#EXPORT = qw(send_request, create_mmd_and_transfer, update_mmd_file);
sub send_request {
my ( $service, $action, $torole ) = #_;
my ( $seller_request_mmd );
my $replace_contents = ();
$replace_contents{"REPLACE_Service"} = $service;
$replace_contents{"REPLACE_RequestAction"} = $action;
$replace_contents{"REPLACE_TradingPartner"} = $torole;
$replace_contents{"REPLACE_Requestxml"} = "Request.xml";
create_mmd_and_transfer( \%replace_contents, $seller_request_mmd, "/MMD.xml" );
}
sub create_mmd_and_transfer {
my $local_replace_contents = shift;
my $input_mmd = shift;
my $local_output_mmd = shift;
my $output_mmd = shift;
update_mmd_file( "$input_mmd", "temp_mmd_file.xml", $local_replace_contents );
}
sub update_mmd_file {
my $input_file = shift;
my $output_file = shift;
my $contents = shift;
open( MMD_FILE, "<$input_file" )
or main::error_exit(" Cannot open MMD file template $input_file \n $input_file not found int the Templates folder \n Please place the same and then run the script ");
open( TEMP_MMD_FILE, ">$output_file" );
while ( <MMD_FILE> ) {
s/^M//g; # Getrid of the ^Ms
foreach my $content ( keys( %$contents ) ) {
my $exact_value = ${%$contents}{$content};
if ( $main::test_scenario =~ /^Invalid Request Action \a\n\d Service/
and ( $content =~ /REPLACE_Service|REPLACE_RequestAction/i ) ) {
}
else {
if ( $exact_value ne "" ) {
s/$content/$exact_value/g;
}
}
}
print TEMP_MMD_FILE;
}
close MMD_FILE;
close TEMP_MMD_FILE;
}
The following will not make your script work, just create the better base for some future questions.
Before you even thinking about posting a perl question here:
1.) add to the top of your script:
use strict;
use warnings;
Posting a code here without these two lines, nobody will bother even trying to read the code.
2.) use perl -c SomePackage.pm for the check. If it will tell you: SomePackage.pm syntax OK - you can start thinking about posting a question here. ;)
Some basic problems with your script:
package SomePackage;
use strict; # see the above
use warnings;
require Exporter;
# these variables are defined outside of this package, so, tell perl this fact. use the `our`
our #ISA = qw(Exporter);
#the use warnings will warn you about the following line
# #EXPORT = qw(send_request, create_mmd_and_transfer, update_mmd_file);
#the correct one is without commas
our #EXPORT = qw(send_request create_mmd_and_transfer update_mmd_file); #not saying anything about the #EXPORT rudeness. :)
#my $replace_contents = ();
#the $replace_contents is a scalar. Bellow you using a hash. So,
my %replace_contents;
#or use the scalar but the lines bellow should use the hashref notation, e.g.
# $replace_contents->{"REPLACE_Service"} = $service;
# you decide. :)
# the seller_request_mmd contains undef here.
create_mmd_and_transfer( \%replace_contents, $seller_request_mmd, "/MMD.xml");
# also bellow, in the subroutine definition it wants 4 arguments.
# indicates a problem...
# using 2-arg open is not the best practice.
# Also, you should to use lexical filehandles
# open (MMD_FILE, "<$input_file")
# better
open (my $mmd_file, '<', $input_file)
# of course, you need change every MMD_FILE to $mmd_file
# check the result of the open and die if not successful
# or you can use the
use autodie;
# instead of $exact_value = ${%$contents}{$content};
# you probably want
my $exact_value = $contents->{$content};
Indent your code!
All the above are just about the syntactic problems and not solving anything about the "logic" of your code.
Ps: And me is still an beginner, so, others sure will find much more problems with the above code.
Ok. Here's what I've done to test this.
Firstly, you didn't give us an input file or the code that you use to call the module. So I invented them. I made the simplest possible input file:
REPLACE_Service
REPLACE_RequestAction
REPLACE_TradingPartner
REPLACE_Requestxml
And this driver program:
#!/usr/bin/perl
use strict;
use warnings;
use SomePackage;
send_request('foo', 'bar', 'baz');
sub error_exit {
die #_;
}
The first time, I ran it, I got this error:
Undefined subroutine &main::send_request called at test line 8.
That was because your #EXPORT line was wrong. You had:
#EXPORT = qw(send_request, create_mmd_and_transfer, update_mmd_file);
But the point of qw(...) is that you don't need the commas. So I corrected it to:
#EXPORT = qw(send_request create_mmd_and_transfer update_mmd_file);
Then I re-ran the program and got this error:
Cannot open MMD file template
not found int the Templates folder
Please place the same and then run the script at test line 11.
That looked like there was something missing. I changed the error message, adding indicators of where the variable interpolation was supposed to happen:
open( MMD_FILE, "<$input_file" )
or main::error_exit(" Cannot open MMD file template <$input_file> \n <$input_file> not found int the Templates folder \n Please place the same and then run the script ");
Then the error message looked like this:
Cannot open MMD file template <>
<> not found int the Templates folder
Please place the same and then run the script at test line 11.
So it seems clear that the $input_file variable isn't set in the update_mmd_file() subroutine. Tracing that variable back, we see that this value is originally the $seller_request_mmd variable in send_request(). But in send_request() you declare $seller_request_mmd but you never give it a value. So let's do that:
my ( $seller_request_mmd ) = 'test_input.txt';
Now, when I run your program, it runs to completion without any errors. And I find a new temp_mmd_file.xml is generated. But it is exactly the same as the input file. So more investigation is needed.
Digging into the update_mmd_file() subroutine, we find this interesting line:
my $exact_value = ${%$contents}{$content};
I think you're trying to extract a value from $contents, which is a hash reference. But your syntax is wrong. You were probably aiming at:
my $exact_value = ${$contents}{$content};
But most Perl programmers prefer the arrow notation for working with reference look-ups.
my $exact_value = $contents->{$content};
Making that change and re-running the program, I get an output file that contains:
foo
bar
baz
Request.xml
Which is exactly what I expected. So the program now works.
But there is still a lot of work to do. As you have been told repeatedly, you should always add:
use strict;
use warnings;
to your code. That will find a lot of potential problems in your code - which you should fix.
To be honest, this feels to me like you were trying to run before you could walk. I'd recommend spending some time to work through a good Perl introductory book before taking on my more Perl work.
And there was a lot of useful information missing from your question. It wouldn't have taken as long to get to the solution if you had shown us your driver program and your input data.

How can I use "member" variables of a module inside a function?

I have this code:
#!/usr/bin/perl
package Modules::TextStuff;
use strict;
use warnings;
use Exporter;
our #ISA = qw(Exporter);
our #EXPORT = qw(get_text);
my $author;
my $text_tmp1 =<<'ENG';
This is a template text
by $author.
ENG
sub get_text {
my $tmp = shift #_;
$author = shift #_;
print "In sub author= $author lang = $tmp \n";
my $final_str = eval('$text_'.$tmp);
print "$final_str \n";
return $final_str;
}
1;
Test script:
#!/usr/bin/perl
use strict;
use warnings;
use Modules::TextStuff;
my $str = get_text('tmp1','jim');
print $str;
When I run the test script it does not work. I get:
In sub author=jim lang = eng
Variable "$text_tmp1" is not available at (eval 1) line 2. Use of
uninitialized value $final_str in concatenation (.) or string
How can I fix this?
Combining strings to create variables names is usually a bad idea. You could salvage your current program using our $text_tmp1 = ... instead of my $text_tmp1 = ..., but I think you should consider a different approach, like a hash:
my %templates = (
tmp1 => <<ENG,
This is a template text
by \$author.
ENG
tmp2 => <<ESP,
Esta es templata texta de \$author.
ESP
);
sub get_text {
...
my $final_str = eval( $templates{$tmp} );
...
}
The error you asked about is generated when eval EXPR tries to grab the value of a variable that did exist, but no longer exists.
>perl -wE"{ my $x = 123; sub f { eval '$x' } } say '<'.f().'>';"
Variable "$x" is not available at (eval 1) line 2.
Use of uninitialized value in concatenation (.) or string at -e line 1.
<>
Remember, executing a file (such as a script or a module) is done in its own a lexical scope, just like the one the curlies create above.
It can be fixed by keeping the variable alive by not letting it go out of scope
>perl -wE"my $x = 123; sub f { eval '$x' } say '<'.f().'>';"
<123>
But that's not an option for you.
Other options include making the variable a global variable.
>perl -wE"{ our $x = 123; sub f { eval '$x' } } say '<'.f().'>';"
<123>
Or forcing the sub to capture it so it doesn't cease to exist.
>perl -wE"{ my $x = 123; sub f { $x if 0; eval '$x' } } say '<'.f().'>';"
<123>
(The if 0 silences the "void context" warning.)
That said, it looks like you're trying to re-invent the wheel. Don't invent another half-assed templating system.
I'm looking at several things:
First of all, $text_tmp1 is not a package variable. It's lexically scoped since you declared it with my. If you need it as a package variable and for it to be visible in all or your subroutines, you need to declare it with our.
Your module doesn't compile as written. You are trying to source in $author, but it's not defined.
What are you doing with eval? This is wrong on so many levels.
Here's how I would do it:
#! /usr/bin/env perl
package Modules::TextStuff;
use strict;
use warnings;
use Exporter qw(import);
use Carp;
our #EXPORT_OK = qw(get_text);
our %templates; # This is now a package variable
#
# TEMPLATES
#
$templates{tmp1}=<<TEMPLATE; # We'll use `%s` for replacements
This is a template text
by %s.
TEMPLATE
$templates{tmp2}=<<TEMPLATE;
This is another template and we will substitute
in %s in this one too.
TEMPLATE
sub get_text {
my $template = shift;
my $author = shift;
if ( not exists $templates{$template} ) {
croak qq(Invalid template name "$template");
}
return sprintf $templates{$template}, $author;
}
1;
I'll make each of these templates an entry in my %templates hash. No need for eval to calculate out a variable name for the template. Also notice that I can now actually test whether the user passed in a valid template or not with the exists.
Also note that %template is declared with our and not my. This makes it available in the entire package including any subroutines in my package.
I also use #EXPORT_OK instead of #EXPORT. It's considered more polite. You're requesting permission to pollute the user's namespace. It's like knocking on someone's door and asking if you can have a beer rather than barging in and rummaging through their fridge for a beer.
Note how I use sprintf to handle the replaceable parameters. This again removes the need for eval.
I also prefer to use #! /usr/bin/env perl on my program header since it's more compatible with things like Perlbrew. You're using /usr/bin/env to find the executable Perl program that's in the user's path. This way, you don't have to know whether it's /bin/perl, /usr/bin/perl, /usr/local/bin/perl, or $HOME/perl5/perlbrew/perls/perl-5.18.0/bin/perl
To use your module, I would do this:
#! /usr/bin/env perl
use strict;
use warnings;
use feature qw(say);
use Modules::TextStuff qw(get_text);
say get_text('tmp1','jim');
Pretty much the same call you made. This prints out:
This is a template text
by jim.

Dependency between perl modules

Suppose I have three perl modules as given below :
Test.pm
package Test;
use strict;
use warnings;
use Check;
our $data = Check->getX;
1;
Initialize.pm
package Initialize;
use Check;
use Test;
Check->setX(10);
our $t = $Test::data;
print $t;
1;
Check.pm
package Check;
my $x = 12;
sub setX {
my ($self,$value) = #_;
$x = $value;
}
sub getX
{
return $x;
}
1;
Now, when I run Initialize.pm, I am initializing $x in Check.pm to 10 and $x is assigned to $data in Test.pm. But the the actual valuethat is assigned to $data is 12 which is the initial value given in Check.pm.
So, When are the global variables initialized in perl? How can I enforce that the new value set by me in the Initialize.pm to x is what is loaded into $data?
Now if I replace the statement use Test in Initalize.pm with require Test; and move the statement Check->setX(10) before this require statement then $data is correctly initialized to the new value 10. What is it that is happening differently in this case ?
In general modules have little or no executable code. Object-oriented modules just define the object methods, and sometimes some class data.
When you use Test the whole of Test.pm is compiled and executed, so the value of $data is set at this point.
The call to setX happens straight afterwards, but is too late to affect the asignment of $data.
As I said in my comment your code has a very odd structure, and modules shouldn't have a time dependency on each other at all. You should really remove all executable statements from your modules, but to force your code to do what you want you can write
use strict;
use warnings;
use Check;
BEGIN {
Check->setX(10);
}
use Test;
our $t = $Test::data;
print $t;
But don't do that!
Perl executes a use statement prior to executing anything else in the file.
So the execution order is:
use Check;
$x = 12;
use Test;
use Check; -This only does importing as the file is already executed
$data = Check->getX();
Check->setX(10);
If you replace use with require the instruction is evaluated at the same time as the rest of the instructions and if you move Check->setX(10); before the require it will be evaluated before the get in Test

In perl, how can I find out the module where a specific exported function is defined? [duplicate]

I have a code which calls the function. But I don't know the module this function belongs to. I need it to modify this function.
How can I check it?
The Devel::Peek module is very handy to get all sorts of information about variables. One of the things you can do with it is dump a reference to a subroutine and get the name of the glob it came from:
$ perl -MDevel::Peek -MList::Util=first -e'Dump(\&first)'
SV = IV(0x1094e20) at 0x1094e28
REFCNT = 1
FLAGS = (TEMP,ROK)
RV = 0x11183b0
SV = PVCV(0x10ff1f0) at 0x11183b0
REFCNT = 3
FLAGS = (POK,pPOK)
PROTOTYPE = "&#"
COMP_STASH = 0x0
XSUB = 0x7f7ecbdc61b0
XSUBANY = 0
GVGV::GV = 0x11183c8 "List::Util" :: "first"
FILE = "ListUtil.c"
DEPTH = 0
FLAGS = 0x800
OUTSIDE_SEQ = 0
PADLIST = 0x0
OUTSIDE = 0x0 (null)
the GVGV::GV part in there is the important bit.
An alternative solution would be Sub::Identify, which really only gives you names for code references you hand to it. However, knowing about Devel::Peek is handy in many other situations too, so I mentioned that first.
Perl's debugger can dig down the way you want. For example:
main::(-e:1): 0
DB<1> sub foo {}
DB<2> x \&foo
0 CODE(0xca6898)
-> &main::foo in (eval 5)[/usr/share/perl/5.10/perl5db.pl:638]:2-2
It does this using Devel::Peek:
=head2 C<CvGV_name_or_bust> I<coderef>
Calls L<Devel::Peek> to try to find the glob the ref lives in; returns
C<undef> if L<Devel::Peek> can't be loaded, or if C<Devel::Peek::CvGV> can't
find a glob for this ref.
Returns C<< I<package>::I<glob name> >> if the code ref is found in a glob.
=cut
sub CvGV_name_or_bust {
my $in = shift;
return unless ref $in;
$in = \&$in; # Hard reference...
eval { require Devel::Peek; 1 } or return;
my $gv = Devel::Peek::CvGV($in) or return;
*$gv{PACKAGE} . '::' . *$gv{NAME};
} ## end sub CvGV_name_or_bust
You might exercise it with
#! /usr/bin/perl
use warnings;
use strict;
package Foo;
sub bar {}
package main;
BEGIN { *baz = \&Foo::bar }
sub CvGV_name_or_bust { ... }
print CvGV_name_or_bust(\&baz), "\n";
Output:
Foo::bar
Note that the example above gives Foo:bar a different name, but you get both the package where the aliased sub resides and also its name there.
If the function was automatically imported from another module using Exporter, it can be found in this module's #EXPORT global variable:
perl -MEncode -e 'print join "\n", #Encode::EXPORT'
decode
decode_utf8
...
You can provide a list of functions to use. This way you will always know which package a function belongs:
use Encode qw[ encode ]; # encode() imported from the Encode module
use Data::Dumper qw[]; # no functions imported from Data::Dumper
You can pass to Sub::Identify::sub_fullname any subroutine reference and it will show you the module where this sub was defined:
use Sub::Identify qw/sub_fullname/;
sub foo {
print sub_fullname( \&foo ); # main::foo
print sub_fullname( sub{} ); # main::__ANON__
}
foo();
For details see Sub::Identify