I have a Perl script which uses Module::Reload::Selective to load a module. The perl script looks like this, more or less.
#!/usr/bin/perl
use strict;
use warnings;
use Module::Reload::Selective;
&reload;
sub reload {
Module::Reload::Selective->reload(qw(myModule));
import myModule qw($reloadtime);
$reloadtime = ${myModule::reloadtime};
}
The module looks like this:
package myModule;
use Config::General;
use Data::Dumper;
use DBI;
use HTTP::Request::Common qw { POST };
use HTTP::Headers;
use JSON::XS;
use LWP::UserAgent;
use Module::Pluggable search_path => "Bot";
use POSIX qw(strftime ceil);
# stuff here
1;
When I run the main script I get about 100 like this:
Subroutine export_fail redefined at /usr/local/share/perl/5.14.2/Carp.pm line 64.
Subroutine _cgc redefined at /usr/local/share/perl/5.14.2/Carp.pm line 66.
Subroutine longmess redefined at /usr/local/share/perl/5.14.2/Carp.pm line 72.
Subroutine shortmess redefined at /usr/local/share/perl/5.14.2/Carp.pm line 92.
Subroutine croak redefined at /usr/local/share/perl/5.14.2/Carp.pm line 100.
Subroutine confess redefined at /usr/local/share/perl/5.14.2/Carp.pm line 101.
Subroutine carp redefined at /usr/local/share/perl/5.14.2/Carp.pm line 102.
I noticed if I comment out some of the "use" statements in my module these will go away. But I need those. I've searched all over and tried a number of things. to no avail.
Sometimes it is ok to redefine subroutines. If you know what you are doing and want to suppress the warnings, just put
no warnings 'redefine';
at the top of your reload method.
Another option, again, so long as you know what you doing, is to temporarily disable the builtin warnings handler:
sub reload {
local $SIG{__WARN__} = sub {};
... do something that warns ...
}
And as a last resort, since warnings are written to STDERR, you can temporarily redirect STDERR.
sub reload {
open my $devnull, '>/dev/null'; # Windows: >nul
local *STDERR = *$devnull;
... do something that warns ...
}
I had this too. In my case I tracked the error down to the plugins() call in Module::Pluggable. If that's where your noise comes from too this might work for you also.
answer is in the weeds here: http://cpansearch.perl.org/src/SIMONW/Module-Pluggable-5.1/lib/Module/Pluggable.pm
where it explains that plugins() is called more than necessary which can get expensive, so you do something like this:
package Foo;
use strict;
use Module::Pluggable sub_name => '_plugins';
our #PLUGINS;
sub plugins { #PLUGINS ||= shift->_plugins }
1;
That didn't exactly work for me at first, but it did when I fleshed out the plugins() sub into several lines and populated/returned an array ref in my $self.
Related
I reviewed many examples on-line about running another process (either PERL or shell command or a program), but do not find any useful for my needs way.
(As by already received answers I see that my 'request' is not understood, I will try to say it in short, leaving all earlier printed as an example of what I already tried...)
I need:
- In a caller script set parameters for the second script before call the second script (thus, I could not use the do script2.pl s it executed before startin to run the first script)
- In the second script I need to set some variables that will be used in the caller script (therefore it is not useful to process the second script by system() or by back ticks);
- and, as I need to use those variables in the first script, I need come back to the first script after completting the second one
(I hope now it is more clear what I need...)
(Reviewed and not useful the system(), 'back ticks', exec() and open())
I would like to run another PERL-script from a first one, not exiting (as by exec()), not catching the STDOUT of the called script (as in the back tick processing,) but having it printed out, as in initial script (as it is by system()) while I do not need the return status (as by system());
but, I would like to have the called script to set some variables, that will be accessible in the calling s cript (sure, set by the our #set_var;)
My attempt (that I am not able to make do what I need) is:
Script1 is something, like:
...
if($condition)
{ local $0 = 'script2.pl';
local #ARGV = ('first-arg', 'second_arg');
do script2.pl;
}
print "set array is: '#set_var'\n";
...
The 'script2' would have something like:
#!/usr/bin/perl
...
print "having input parameters: '#ARGV'\n";
... # all script activities
our #set_var = ($val1, $val2, $val3);
exit 0;
The problem in my code is that the do ... command is executed on beginning of the first script run and is not in the place, where it is prepared for it (by setting some local .. vars!)
I did try to use the eval "do script2.pl" :
- now it is executed in the proper place, but it is not setting the #set_var into the first script process!
Is there any idea to do it as I would like to have it?
(I understand, that I can rewrite the script2.pl, including whole processing in some function (say, main()) and load it by require() and execute the function main(): that will do everything as I prefer it; but I would like to leave the second script as-is to be executable from shell by itself, as it is now.
... and I do not like the way to pass values by a flat file...)
Does anybody have an idea how to do my whim?
This works just fine:
script2.pl
use strict;
our #set_var = ("foo","bar");
script1.pl
use strict;
our #set_var;
do './script2.pl';
print "#set_var\n";
$ perl script1.pl
foo bar
But it does not if you use:
script2.pl
use strict;
our #set_var = ("foo","bar");
exit 0;
There is only a single perl process in this example, so calling exit, even from the second script, exits your program.
If you don't want to remove the exit call in the second script, we can work around that with some CORE::GLOBAL namespace hacking. The gist is to redirect the exit function to your own custom function that you can manipulate when the second script runs.
script1.pl
BEGIN { *CORE::GLOBAL::exit = *my_exit };
use strict;
sub my_exit { goto &CORE::exit }
our #set_var;
{
local *my_exit = sub { warn "Not exiting" };
do './script2.pl';
}
print "#set_var\n";
script2.pl
use strict;
our #set_var = ("foo","bar");
exit 0;
$ perl script1.pl
Not exiting at script1.pl line 7.
foo bar
(Ok, finally, asked by myself and ansvering by myself, too!)
( After additional reviewing, I am realized, that 'mod' solution does use it, but I did not understand advice!
I am sorry: my false to step over the real solution!
)
Solution to my question is simple! It is the:
do EXPR;
That way
- the second script executed in place where it placed; so, anything defined and set in the first one usefull in the second one;
- It is printing to STDOUT everything what it should print (the second script;)
- any variables or objects that are defined in the second script process, are accessible in the first one after coming back; and
- control is returned to position immediately after the second-script execution with continuation to process the first script commands!
Simple! I am just amazed, why I forget about that 'do...' command. I have used it already not once!
And I am disappointed by that forum much!
While it is badly designed to display communication, participants, instead of perl-issue reviewing, much concerned on moderating others, teaching them how to leave in such nice forum!
I am not really sure what you are trying to do exactly, but along these lines it should be very close.
test.pl
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
use IPC::System::Simple qw(system);
say $0;
system($^X, "sample.pl", #ARGV);
$ perl test.pl first-arg second-arg
test.pl
sample.pl
$VAR1 = [
'first-arg',
'second-arg'
];
sample.pl
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
use feature 'say';
say $0;
print Dumper \#ARGV;
I used the module IPC::System::Simple. You can also capture the output of the script (sample.pl) through IPC::System::Simple::capture.
Update: Maybe you can use Storable. This way you can pass new parameters that you can use from script 2 (sample.pl) to script 1 (test.pl).
test.pl
#!/usr/bin/perl
use strict;
use warnings;
use Storable;
use Data::Dumper;
use feature 'say';
use IPC::System::Simple qw(system);
say $0;
system($^X, "sample.pl", #ARGV);
my $hashref = retrieve('sample');
print Dumper $hashref;
__END__
$ perl test.pl first-arg second-arg
test.pl
sample.pl
$VAR1 = [
'first-arg',
'second-arg'
];
$VAR1 = {
'arg1' => 'test1',
'arg2' => 'test2'
};
sample.pl
#!/usr/bin/perl
use strict;
use warnings;
use Storable;
use Data::Dumper;
use feature 'say';
say $0;
print Dumper \#ARGV;
my %hashArgs = ( arg1 => 'test1',
arg2 => 'test2', );
store \%hashArgs, 'sample';
I want to write a small subroutine that can decorate all error messages in a consistent way instead of having to copy it all around my program.
However I want the line numbers to be from where it was called, not from where the die/warn occurred.
In C I would just use a preprocessor macro, but Perl does not have those. What is the best way to implement this?
Use Carp for warnings/errors. You can use __WARN__ and __DIE__ hooks to affect what warn prints to the STDERR stream and how die is thrown. Note that they are quite different.
use warnings;
use strict;
use feature 'say';
use Carp;
$SIG{__WARN__} = \&wrap_warn;
sub wrap_warn {
print "WARNING: #_";
}
sub level_2 {
say "Print from level_2";
carp "carp from level_2(#_)";
}
sub level_1 {
level_2(#_);
}
level_1("from main");
prints to STDOUT
Print from level_2
WARNING: carp from level_2(from main) at wrap_warn.pl line 19.
main::level_2('from main') called at wrap_warn.pl line 15
main::level_1('from main') called at wrap_warn.pl line 22
If you want this to still go to STDERR then use print STDERR "WARNING: #_";
Make sure to carefully read about %SIG in perlvar and warn, at least.
While it seems that you want this to be global, I'd like to mention that one generally wants to local-ize changes like this one. There's an example in this post, and more out there.
Adding the following will add stack traces to exceptions and warnings:
use Carp::Always;
For the occasional use, use the following to avoid modifying your program:
perl -MCarp::Always script args
or
PERL5OPT=-MCarp::Always script args
When I load File::Find with require like this, how could I modify this script to not get the warning?
#!/usr/bin/env perl
use warnings;
use strict;
use 5.10.1;
require File::Find;
File::Find->import('find');
find( {
wanted => sub {
my $file = $File::Find::name;
#say $file;
},
no_chdir => 1,
},
shift );
Output:
#Name "File::Find::name" used only once: possible typo at ./perl9.pl line 11.
Just replace the require with use. That'll fix it.
Generally, the only reason to ever use require is if you have some specific reason to do deferred module loading at runtime. Usually, you don't.
If you just don't want to import any symbols from the module, pass an empty list to use, like this:
use File::Find ();
or
use File::Find qw();
Edit: If you do have a legitimate reason to defer the module loading, and find ikegami's workaround too ugly, you can just disable the warning locally by writing:
no warnings 'once';
before the statement generating the warning. This will disable that particular warning for the rest of the innermost enclosing code block. To find out which warning messages belong in which classes, see perldiag.
For starters, don't load the file like that. :)
If you do, just add:
$File::Find::name if 0;
The clean way of doing it is to change $File::Find::name to
do { no warnings 'once'; $File::Find::name }
I want use some packages and some pragmas in all my programs, like:
use 5.014;
use warnings;
use autodie;
use My::ModuleA::Something;
use ModuleB qw(Func1 Func2);
I don't want repeat myself in every module, so looking for a way how to make one package e.g. My::Common what will contain the above packages and in my programs do only:
use My::Common;
say Func1("hello"); #say enabled and Func1 imported in the My::Common
how to achieve this?
The was read preldoc -f use and perldoc perlmodlib so i think I must "somewhat" to do this with BEGIN plus require&import, but absolutely don't know how.
UPDATE: I'm already tried the basic things.
With require - my prg.pl program.
require 'mymods.pl';
$var = "hello";
croak "$var\n";
mymods.pl contain
use strict;
use feature 'say';
use Carp qw(carp croak cluck);
1;
DOES NOT WORKS. Got error:
$ perl prg.pl
String found where operator expected at prg.pl line 3, near "croak "$var\n""
(Do you need to predeclare croak?)
syntax error at prg.pl line 3, near "croak "$var\n""
Execution of prg.pl aborted due to compilation errors.
with "use My":
use My;
$var = "hello";
croak "$var\n";
my My.pm
package My;
use strict;
use feature 'say';
use Carp qw(carp croak cluck);
1;
DOES NOT WORKS either. Got the same error.
Any working idea?
I'd go with this:
package My::Common;
use 5.14.0;
use strict;
use warnings;
use autodie;
use Carp qw(carp croak cluck);
sub import {
my $caller = caller;
feature->import(':5.14');
# feature->import('say');
strict->import;
warnings->import;
## autodie->import; # <-- Won't affect the caller side - see my edit.
{
no strict 'refs';
for my $method (qw/carp croak cluck/) {
*{"$caller\::$method"} = __PACKAGE__->can($method);
}
}
}
1;
Please correct me if I'm wrong, or there's a better way.
EDIT:
Sorry, I was wrong in using autodie->import...
This one should work, but it assumes that you always call My::Common from the main package:
package My::Common;
# ...
sub import {
# ...
strict->import;
warnings->import;
{
package main;
autodie->import;
}
# ...
}
So, of course, it's much safer and simpler to add a use autodie; to each script:
use My::Common;
use autodie;
# ...
It's actually fairly simple, if you override your "common" module's import method. See the source of chromatic's Modern::Perl module for an example of exporting pragmas.
For re-exporting things defined in other modules, I seem to recall that $export_to_level (see the Exporter docs, although it's not explained all that clearly) should do that, although I can't find any good examples at the moment. Another option would be Pollute::persistent, although I haven't used it, don't know anyone else who's used it, and can't say how stable/solid it's likely to be. If it works, though, it's probably the quickest and easiest option.
I've just noticed a module called rig in CPAN. Try it out.
I am maintaining several Perl scripts that all have similar code blocks for different functions. Each time a code block is updated, I have to go through each script and manually make the change.
Is there a way to encapsulate the common functions into their own scripts and call them?
Put the common functionality in a module. See perldoc perlmod for details.
There are other ways, but they all have severe issues. Modules are the way to go, and they don't have to be very complicated. Here is a basic template:
package Mod;
use strict;
use warnings;
use Exporter 'import';
#list of functions/package variables to automatically export
our #EXPORT = qw(
always_exported
);
#list of functions/package variables to export on request
our #EXPORT_OK = qw(
exported_on_request
also_exported_on_request
);
sub always_exported { print "Hi\n" }
sub exported_on_request { print "Hello\n" }
sub also_exported_on_request { print "hello world\n" }
1; #this 1; is required, see perldoc perlmod for details
Create a directory like /home/user/perllib. Put that code in a file named Mod.pm in that directory. You can use the module like this:
#!/usr/bin/perl
use strict;
use warnings;
#this line tells Perl where your custom modules are
use lib '/home/user/perllib';
use Mod qw/exported_on_request/;
always_exported();
exported_on_request();
Of course, you can name the file anything you want. It is good form to name the package the same as file. If you want to have :: in the name of the package (like File::Find) you will need to create subdirectories in /home/user/perllib. Each :: is equivalent to a /, so My::Neat::Module would go in the file /home/user/perllib/My/Neat/Module.pm. You can read more about modules in perldoc perlmod and more about Exporter in perldoc Exporter
About a third of Intermediate Perl is devoted to just this topic.
Using a module is the most robust way, and learning how to use modules would be helpful.
Less efficient is the do function. Extract your code to a separate file, say "mysub.pl", and
do 'mysub.pl';
This will read and then eval the contents of the file.
You can use the
require "some_lib_file.pl";
where you would put all your common functions and call them from other scripts which would contain the line above.
For example:
146$ cat tools.pl
# this is a common function we are going to call from other scripts
sub util()
{
my $v = shift;
return "$v\n";
}
1; # note this 1; the 'required' script needs to end with a true value
147$ cat test.pl
#!/bin/perl5.8 -w
require 'tools.pl';
print "starting $0\n";
print util("asdfasfdas");
exit(0);
148$ cat test2.pl
#!/bin/perl5.8 -w
require "tools.pl";
print "starting $0\n";
print util(1);
exit(0);
Then executing test.pl and test2.pl will yield the following results:
149$ test.pl
starting test.pl
asdfasfdas
150$ test2.pl
starting test2.pl
1