get caller module code in perl - perl

How could I get actual code from the caller module in perl?
some_module.pm
package some_module;
use my_module;
CODE
CODE
my_module.pm
package my_module;
sub import {
my $package = caller;
my $code = actual perl code of some_module.pm;
}
Is this possible, or would I have to use an open function? I would think source filters do something similar.

There's a CPAN module called B::Hooks::Parser that allows you to not just see, but alter the line where you were called. (That is, not alter it on disk, but alter what Perl sees while it's parsing the line.) Though you cannot see or alter the part of the line which has already been compiled. This only works at compile time of course, and because the Perl parser reads and tokenizes one line at a time, it is limited to looking at a single line.
If you need to see the entire file that's called you, you can use:
open my $caller_fh, '<', (caller)[1]
or die("Cannot open caller: $!");
However (caller)[1] might not always return a real filename - for example, if you are called from a one-liner, it will be "-e", or from a stringy eval will be something like "(eval 23)".

Related

Calling one Perl program from another

I have two Perl files and I want to call one file from another with arguments
First file a.pl
$OUTFILE = "C://programs/perls/$ARGV[0]";
# this should be some out file created inside work like C://programs/perls/abc.log
Second File abc.pl
require "a.pl" "abc.log";
# $OUTFILE is a variable inside a.pl and want to append current file's name as log.
I want it to create an output file with the name of log as that of current file.
One more constraint I have is to use $OUTFILE in both a.pl and abc.pl.
If there is any better approach please suggest.
The require keyword only takes one argument. That's either a file name or a package name. Your line
require "a.pl" "abc.log";
is wrong. It gives a syntax error along the lines of String found where operator expected.
You can require one .pl file from another .pl, but that is very old-fashioned, badly written Perl code.
If neither file defines a package then the code is implicitly placed in the main package. You can declare a package variable in the outside file and use it in the one that is required.
In abc.pl:
use strict;
use warnings;
# declare a package variable
our $OUTFILE = "C://programs/perls/filename";
# load and execute the other program
require 'a.pl';
And in a.pl:
use strict;
use warnings;
# do something with $OUTFILE, like use it to open a file handle
print $OUTFILE;
If you run this, it will print
C://programs/perls/filename
You should convert your perl file you want to call to a perl module:
Hello.pm
#!/usr/bin/perl
package Hello;
use strict;
use warnings;
sub printHello {
print "Hello $_[0]\n"
}
1;
Then you can call it:
test.pl
#!/usr/bin/perl
use strict;
use warnings;
# you have to put the current directory to the module search path
use lib (".");
use Hello;
Hello::printHello("a");
I tested it in git bash on windows, maybe you have to do some modifications in your environment.
In this way you can pass as many arguments as you would like to, and you don't have to look for the variables you are using and maybe not initialized (this is a less safe approach I think, e.g. sometimes you will delete something you did't really want) somewhere in the file you want to call. The disadvantage is that you need to learn a bit about perl modules but I think it definitely worths.
A second approach could be to use the exec/system call (you can pass arguments in this way too; if forking a child process is acceptable), but that is an another story.
I would do this another way. Have the program take the name of the log file as a command-line parameter:
% perl a.pl name-of-log-file
Inside a.pl, open that file to append to it then output whatever you like. Now you can run it from many other sorts of places besides another Perl program.
# a.pl
my $log_file = $ARGV[0] // 'default_log_name';
open my $fh, '>>:utf8', $log_file or die ...;
print { $fh } $stuff_to_output;
But, you could also call if from another Perl program. The $^X is the path to the currently running perl and this uses system in the slightly-safer list form:
system $^X, 'a.pl', $name_of_log_file
How you get something into $name_of_log_file is up to you. In your example you already knew the value in your first program.

Using filehandles in Perl to alter actively running code

I've been learning about filehandles in Perl, and I was curious to see if there's a way to alter the source code of a program as it's running. For example, I created a script named "dynamic.pl" which contained the following:
use strict;
use warnings;
open(my $append, ">>", "dynamic.pl");
print $append "print \"It works!!\\n\";\n";
This program adds the line
print "It works!!\n";
to the end of it's own source file, and I hoped that once that line was added, it would then execute and output "It works!!"
Well, it does correctly append the line to the source file, but it doesn't execute it then and there.
So I assume therefore that when perl executes a program that it loads it to memory and runs it from there, but my question is, is there a way to access this loaded version of the program so you can have a program that can alter itself as you run it?
The missing piece you need is eval EXPR. This compiles, "evaluates", any string as code.
my $string = q[print "Hello, world!";];
eval $string;
This string can come from any source, including a filehandle.
It also doesn't have to be a single statement. If you want to modify how a program runs, you can replace its subroutines.
use strict;
use warnings;
use v5.10;
sub speak { return "Woof!"; }
say speak();
eval q[sub speak { return "Meow!"; }];
say speak();
You'll get a Subroutine speak redefined warning from that. It can be supressed with no warnings "redefine".
{
# The block is so this "no warnings" only affects
# the eval and not the entire program.
no warnings "redefine";
eval q[sub speak { return "Shazoo!"; }];
}
say speak();
Obviously this is a major security hole. There is many, many, many things to consider here, too long for an answer, and I strongly recommend you not do this and find a better solution to whatever problem you're trying to solve this way.
One way to mitigate the potential for damage is to use the Safe module. This is like eval but limits what built in functions are available. It is by no means a panacea for the security issues.
With a warning about all kinds of issues, you can reload modules.
There are packages for that, for example, Module::Reload. Then you can write code that you intend to change in a module, change the source at runtime, and have it reloaded.
By hand you would delete that from %INC and then require, like
# ... change source code in the module ...
delete $INC{'ModuleWithCodeThatChages.pm'};
require ModuleWithCodeThatChanges;
The only reason I can think of for doing this is experimentation and play. Otherwise, there are all kinds of concerns with doing something like this, and whatever your goal may be there are other ways to accomplish it.
Note The question does specify a filehandle. However, I don't see that to be really related to what I see to be the heart of the question, of modifying code at runtime.
The source file isn't used after it's been compiled.
You could just eval it.
use strict;
use warnings;
my $code = <<'__EOS__'
print "It works!!\n";
__EOS__
open(my $append_fh, ">>", "dynamic.pl")
or die($!);
print($append_fh $code);
eval("$code; 1")
or die($#);
There's almost definitely a better way to achieve your end goal here. BUT, you could recursively make exec() or system() calls -- latter if you need a return value. Be sure to setup some condition or the dominoes will keep falling. Again, you should rethink this, unless it's just practice of some sort, or maybe I don't get it!
Each call should execute the latest state of the file; also be sure to close the file before each call.
i.e.,
exec("dynamic.pl"); or
my retval;
retval = system("perl dynamic.pl");
Don't use eval ever.

Finding the standard out for a perl program

I'm redirecting standard out for a perl program. Example:
perl run_program.pl > /log/run_program.log
Is there a way to know what the standard out is. So in this case I'm looking to have the value of '/log/run_program.log'.
If it's not possible is there another/better way to get the same result?
Thanks in advance!
EDIT: The reason I'm not setting STDOUT in the program is because I'm calling a bunch of .pm that have print lines that I want to go to STDOUT with out having to pass the file to it.
On my system, you can use
readlink("/proc/$$/fd/1")
EDIT: The reason I'm not setting STDOUT in the program is because I'm calling a bunch of .pm that have print lines that I want to go to STDOUT with out having to pass the file to it.
Just to let you know, you might be able to use the select command to redefine the FD for the default output:
use strict;
use warnings;
use autodie;
open my $output_fd, ">", "/log/run_program.log";
my $old_default_fd = select( $output_fd );
print "I'm now going into /log/run_program.log\n";
select ($old_default_fd; # Restore the default when you no longer need it
This may work with most of your Perl modules. Just hope that they're not doing something stupid like:
print STDOUT "Ha, ha. I'm still going to STDOUT.\n".
I hate it when Perl modules print stuff.
<soapbox>
To you Perl Module writers:
Perl modules should not be printing (unless that's their main purpose). You should instead return what you want to print and let the caller decide what to do with the output.
</soapbox>
For the first part of your question, no. There's no way for the perl program to know where STDOUT is directed to.
The redirection happens external to the program, and is "wired up" before the perl process even starts. STDOUT could be pointed to a device, a file, or another process (a pipe).
The whole purpose of redirection from stdout to a file is to adapt a program which typically writes to stdout and redirect it to a file. The OS doesn't give you the name of the file, because it figures your program is too stupid to know what to do with a file name.
So your best bet is to get it as my $file_name = shift; and open it yourself. (A shift in the mainline pulls from #ARGV.)
Give a chance to this ideas:
...
my $log_path = "/log/run_program.log"; # or using $0 in some manner
open $log_handler, "<", $log_path or die;
...
Now you could code a myprint subroutine that will call print $log_handler and use it into the whole program, or better, having a look to OVERRIDING CORE FUNCTIONS you could self redefine print doing like this:
...
use subs 'print';
sub print { #redefine here }
...

Perl - New definition of myprint() or Overload print command

I am a newb to Perl. I am writing some scripts and want to define my own print called myprint() which will print the stuff passed to it based on some flags (verbose/debug flag)
open(FD, "> /tmp/abc.txt") or die "Cannot create abc.txt file";
print FD "---Production Data---\n";
myprint "Hello - This is only a comment - debug data";
Can someone please help me with some sample code to for myprint() function?
Do you care more about writing your own logging system, or do you want to know how to put logging statements in appropriate parts of your program which you can turn off (and, incur little performance penalty when they are turned off)?
If you want a logging system that is easy to start using, but also offers a world of features which you can incrementally discover and use, Log::Log4perl is a good option. It has an easy mode, which allows you to specify the desired logging level, and emits only those logging messages that are above the desired level.
#!/usr/bin/env perl
use strict; use warnings;
use File::Temp qw(tempfile);
use Log::Log4perl qw(:easy);
Log::Log4perl->easy_init({level => $INFO});
my ($fh, $filename) = tempfile;
print $fh "---Production Data---\n";
WARN 'Wrote something somewhere somehow';
The snippet also shows a better way of opening a temporary file using File::Temp.
As for overriding the built-in print … It really isn't a good idea to fiddle with built-ins except in very specific circumstances. perldoc perlsub has a section on Overriding Built-in Functions. The accepted answer to this question lists the Perl built-ins that cannot be overridden. print is one of those.
But, then, one really does not need to override a built-in to write a logging system.
So, if an already-written logging system does not do it for you, you really seem to be asking "how do I write a function that prints stuff conditionally depending on the value of a flag?"
Here is one way:
#!/usr/bin/env perl
package My::Logger;
{
use strict; use warnings;
use Sub::Exporter -setup => {
exports => [
DEBUG => sub {
return sub {} unless $ENV{MYDEBUG};
return sub { print 'DEBUG: ' => #_ };
},
]
};
}
package main;
use strict; use warnings;
# You'd replace this with use My::Logger qw(DEBUG) if you put My::Logger
# in My/Logger.pm somewhere in your #INC
BEGIN {
My::Logger->import('DEBUG');
}
sub nicefunc {
print "Hello World!\n";
DEBUG("Isn't this a nice function?\n");
return;
}
nicefunc();
Sample usage:
$ ./yy.pl
Hello World!
$ MYDEBUG=1 ./yy.pl
Hello World!
DEBUG: Isn't this a nice function?
I wasn't going to answer this because Sinan already has the answer I'd recommend, but tonight I also happened to be working on the "Filehandle References" chapter to the upcoming Intermediate Perl. That are a couple of relevant paragraphs which I'll just copy directly without adapting them to your question:
IO::Null and IO::Interactive
Sometimes we don't want to send our output anywhere, but we are forced
to send it somewhere. In that case, we can use IO::Null to create
a filehandle that simply discards anything that we give it. It looks
and acts just like a filehandle, but does nothing:
use IO::Null;
my $null_fh = IO::Null->new;
some_printing_thing( $null_fh, #args );
Other times, we want output in some cases but not in others. If we are
logged in and running our program in our terminal, we probably want to
see lots of output. However, if we schedule the job through cron, we
probably don't care so much about the output as long as it does the job.
The IO::Interactive module is smart enough to tell the difference:
use IO::Interactive;
print { is_interactive } 'Bamboo car frame';
The is_interactive subroutine returns a filehandle. Since the
call to the subroutine is not a simple scalar variable, we surround
it with braces to tell Perl that it's the filehandle.
Now that you know about "do nothing" filehandles, you can replace some
ugly code that everyone tends to write. In some cases you want output
and in some cases you don't, so many people use a post-expression
conditional to turn off a statement in some cases:
print STDOUT "Hey, the radio's not working!" if $Debug;
Instead of that, you can assign different values to $debug_fh based
on whatever condition you want, then leave off the ugly if $Debug
at the end of every print:
use IO::Null;
my $debug_fh = $Debug ? *STDOUT : IO::Null->new;
$debug_fh->print( "Hey, the radio's not working!" );
The magic behind IO::Null might give a warning about "print() on
unopened filehandle GLOB" with the indirect object notation (e.g.
print $debug_fh) even though it works just fine. We don't get that
warning with the direct form.

Why am I unable to load a Perl library when using the `do` function?

I'm new to Perl, and I'm updating an old Perl website. Every .pl file seems to have this line at the top:
do "func.inc";
So I figured I could use this file to tag on a subroutine for global use.
func.inc
#!/usr/bin/perl
sub foobar
{
return "Hello world";
}
index.pl
#!/usr/bin/perl
do "func.inc";
print "Content-type: text/html\n\n";
print foobar();
However, I get this error:
Undefined subroutine &main::foobar called at /path/to/index.pl line 4.
Both files are in the same directory, and there's tones of subs in func.inc already which are used throughout the website. However, the script works in the Linux production environment, but does not work for my Windows 7 dev environment (I'm using ActivePerl).
Update:
It looks like the file is not being included; the sub works if the file is included using an absolute path...
do "C:/path/to/func.inc";
... so it looks like relative paths don't work for my local dev environment, but they work in the production environment through. But this is no good for me, because the absolute path on my dev machine will not work for the live server.
How do I get do to work using a relative path on my Windows 7 dev machine?
Update 2:
I was using the Perl -T switch. Unfortunately this removes "." from #INC, and so stops us from using relative paths for do. I removed this switch and the old code is working now. I'm aware that this is not good practice, but unfortunately I'm working with old code, so it seems that I have no choice.
The perlfunc documentation for do reads
do EXPR
Uses the value of EXPR as a filename and executes the contents of the file as a Perl script.
do 'stat.pl';
is just like
eval `cat stat.pl`;
except that it's more efficient and concise, keeps track of the current filename for error messages, searches the #INC directories, and updates %INC if the file is found.
So to see all this in action, say C:\Cygwin\tmp\mylib\func.inc looks like
sub hello {
print "Hello, world!\n";
}
1;
and we make use of it in the following program:
#!/usr/bin/perl
use warnings;
use strict;
# your code may have unshift #INC, ...
use lib "C:/Cygwin/tmp/mylib";
my $func = "func.inc";
do $func;
# Now we can just call it. Note that with strict subs enabled,
# we have to use parentheses. We could also predeclare with
# use subs qw/ hello /;
hello();
# do places func.inc's location in %INC
if ($INC{$func}) {
print "$0: $func found at $INC{$func}\n";
}
else {
die "$0: $func missing from %INC!";
}
Its output is
Hello, world!
./prog: func.inc found at C:/Cygwin/tmp/mylib/func.inc
As you've observed, do ain't always no crystal stair, which the do documentation explains:
If do cannot read the file, it returns undef and sets $! to the error. If do can read the file but cannot compile it, it returns undef and sets an error message in $#. If the file is successfully compiled, do returns the value of the last expression evaluated.
To check all these cases, we can no longer use simply do "func.inc" but
unless (defined do $func) {
my $error = $! || $#;
die "$0: do $func: $error";
}
Explanations for each case are below.
do cannot read the file
If we rename func.inc to nope.inc and rerun the program, we get
./prog: do func.inc: No such file or directory at ./prog line 12.
do can read the file but cannot compile it
Rename nope.inc back to func.inc and delete the closing curly brace in hello to make it look like
sub hello {
print "Hello, world!\n";
1;
Running the program now, we get
./prog: do func.inc: Missing right curly or square bracket at C:/Cygwin/tmp/mylib/func.inc line 4, at end of line
syntax error at C:/Cygwin/tmp/mylib/func.inc line 4, at EOF
do can read the file and compile it, but it does not return a true value.
Delete the 1; at the end of func.inc to make it
sub hello {
print "Hello, world!\n";
}
Now the output is
./prog: do func.inc: at ./prog line 13.
So without a return value, success resembles failure. We could complicate the code that checks the result of do, but the better choice is to always return a true value at the end of Perl libraries and modules.
Note that the program runs correctly even with taint checking (-T) enabled. Try it and see! Be sure to read Taint mode and #INC in perlsec.
You use the subroutine the same way that you'd use any other subroutine. It doesn't matter that you loaded it with do. However, you shouldn't use do for that. Check out the "Packages" chapter in Intermediate Perl for a detailed explanation of loading subroutines from other files. In short, use require instead.
See the documentation for do. You need to have func.inc (which you can also just call func.pl since pl is "perl library") in one of the directories where Perl will look for libraries. That might be different than the directory that has index.pl. Put func.inc in #INC somewhere, or add its directory to #INC. do also doesn't die if it can't load the file, so it doesn't tell you that it failed. That's why you shouldn't use do to load libraries. :)
Making sure the path is correct, use:
#!/usr/bin/perl
require("func.inc");
print "Content-type: text/html\n\n";
print foobar();
I would first check if the file was actually loaded, the documentation for do mentions that it updates %INC if the file was found. There is also more information in the documentation.
make sure you have func.inc in the correct path.
do "func.inc"
means you are saying func.inc is in the same path as your perl script. check the correct path and then do this
do "/path/func.inc"