I'm working with a module that makes use of some prototypes to allow code blocks. For example:
sub SomeSub (&) { ... }
Since prototypes only work when parsed at compile time, I'd like to throw a warning or even a fatal if the module is not parsed at compile time. For example:
require MyModule; # Prototypes in MyModule won't be parsed correctly
Is there a way to detect if something is being executed at compile or run time/phase in Perl?
If you're running on Perl 5.14 or higher, you can use the special ${^GLOBAL_PHASE} variable which contains the current compiler state. Here's an example.
use strict;
use warnings;
sub foo {
if ( ${^GLOBAL_PHASE} eq 'START' ) {
print "all's good\n";
} else {
print "not in compile-time!\n";
}
}
BEGIN {
foo();
};
foo();
Output:
all's good
not in compile-time!
Before 5.14 (or on or after, too), you can do:
package Foo;
BEGIN {
use warnings 'FATAL' => 'all';
eval 'INIT{} 1' or die "Module must be loaded during global compilation\n";
}
but that (and ${^GLOBAL_PHASE}) doesn't quite check what you want to know, which is whether the code containing the use/require statement was being compiled or run.
Related
th_foo.pm
package Foo;
use Exporter 'import';
our #EXPORT = 'foo';
sub foo { print "foo\n"; }
sub bar { print "bar\n"; }
1;
Case 1
main.pl
use lib '.';
delete $INC{ 'th_foo.pm' };
require 'th_foo.pm';
'Foo'->import();
foo();
Result
$ perl main.pl
foo
Case 2
main.pl
use lib '.';
delete $INC{ 'th_foo.pm' };
require 'th_foo.pm';
'th_foo.pm'->import();
foo();
Result
$ perl main.pl
Undefined subroutine &main::foo called at th.pl line 9.
Question
Can we call Foo's import method by only knowing the file name, th_foo.pm, and not knowing the package name, Foo?
There is no way to get the packages used by an executed file.
You could scan the symbol table beforehand and afterwards and check for differences, but that will also include symbols created by modules used by the file you are executing.
If you can control the th_foo.pm file, you can use the last evaluated expression to pass back information through the require. This only works the first time you require the file in a program, but you're already playing the %INC.
package Foo;
use Exporter 'import';
our #EXPORT = 'foo';
sub foo { print "foo\n"; }
sub bar { print "bar\n"; }
__PACKAGE__;
Then, in the program:
my $package = require 'th_foo.pm';
$package->import;
Again, this is fragile because you must be the first require on that file (otherwise it just returns a boolean). But, in one case I have done something like this, which is sure to get you a beating in code review:
sub my_require ( $file ) {
state %cache;
my $rc = require $file;
$cache{$file} //= $rc;
}
I do this for all of my Makefile.PL files in my Perl dists (example in object-iterate). When I want to process all of my distributions to do something (like, which ones have a minimum version of v5.8?), I require the Makefile.PL and know which package I'm dealing with (although the repo path works too but needs more work).
Curiously, there is a suggestion that we should remove the true value from the end of Perl modules. David Farrell wrote about it in Patching Perl: loading modules that return false and it's now an issue for Perl 7. This doesn't affect the return value though; it just doesn't complain if you return false or empty. It knows it failed through other means.
This question already has answers here:
Is it possible to conditionally "use bigint" with Perl?
(3 answers)
Closed 5 years ago.
How do I get the following code to work?
use strict;
use warnings;
if ($^O eq 'MSWin32' || $^O eq 'MSWin64') {
use Win32;
Win32::MsgBox("Aloha!", MB_ICONINFORMATION, 'Win32 Msgbox');
}
else {
print "Do not know how to do msgbox under UNIX!\n";
}
The above runs under Windows. But under UNIX, there is a compilation error as Win32 cannot be found. Replacing "use" with "require" makes things worse -- the code would fail to compile under both Windows and UNIX because the line containing MB_ICONINFORMATION is always compiled and "MB_ICONINFORMATION" would be an undeclared bare-word.
So how do I get around this problem?
Perl compiles code first to an intermediate representation, then executes it. Since the if is evaluated at runtime but the use is handled during compilation, you are not importing the module conditionally.
To fix this, there are a number of possible strategies:
conditional import with the use if pragma
conditional import with a BEGIN block
require the module
defer compilation with eval
To import a module only when a certain condition is met, you can use the if pragma:
use if $^O eq 'MSWin32', 'Win32';
You can also run code during compilation by putting it into a BEGIN block:
BEGIN {
if ($^O eq 'MSWin32') {
require Win32;
Win32->import; # probably not necessary
}
}
That BEGIN block behaves exactly the same like the above use if.
Note that we have to use require here. With a use Win32, the module would have been loaded during the compile time of the begin block, which bypasses the if. With require the module is loaded during runtime of the begin block, which is during compile time of the surrounding code.
In both these cases, the Win32 module will only be imported under Windows. That leaves the MB_ICONINFORMATION constant undefined on non-Windows systems. In this kind of code, it is better to not import any symbols. Instead, use the fully qualified name for everything and use parentheses for a function call (here: Win32::MB_ICONINFORMATION()). With that change, just using a require instead of an use if may also work.
If you need code to be run later, you can use a string-eval. However, this potentially leads to security issues, is more difficult to debug, and is often slower. For example, you could do:
if ($^O eq 'MSWin32') {
eval q{
use Win32;
Win32::MsgBox("Aloha!", MB_ICONINFORMATION, 'Win32 Msgbox');
1;
} or die $#; # forward any errors
}
Because eval silences any errors by default, you must check success and possibly rethrow the exception. The 1 statement makes sure that the eval'ed code returns a true value if successful. eval returns undef if an error occurs. The $# variable holds the last error.
q{...} is alternative quoting construct. Aside from the curly braces as string delimiters it is exactly the same as '...' (single quotes).
If you have a lot of code that only works on a certain platform, using the above strategies for each snippet is tedious. Instead, create a module for each platform. E.g.:
Local/MyWindowsStuff.pm:
package Local::MyWindowsStuff;
use strict;
use warnings;
use Win32;
sub show_message {
my ($class, $title, $contents) = #_;
Win32::MsgBox("Aloha!", MB_ICONINFORMATION, 'Win32 Msgbox');
}
1;
Local/MyPosixStuff.pm:
package Local::MyPosixStuff;
use strict;
use warnings;
sub show_message {
warn "messagebox only supported on Windows";
}
1;
Here I've written them to be usable as classes. We can then conditionally load one of these classes:
sub load_stuff {
if ($^O eq 'MSWin32') {
require Local::MyWindowsStuff;
return 'Local::MyWindowsStuff';
}
require Local::MyPosixStuff;
return 'Local::MyPosixStuff';
}
my $stuff = load_stuff();
Finally, instead of putting a conditional into your code, we invoke the method on the loaded class:
$stuff->show_message('Aloha!', 'Win32 Msgox');
If you don't want to create extra packages, one strategy is to eval a code ref:
sub _eval_or_throw { my ($code) = #_; return eval "$code; 1" or die $# }
my $show_message =
($^O eq 'MSWin32') ? _eval_or_throw q{
use Win32;
sub {
Win32::MsgBox("Aloha!", MB_ICONINFORMATION, 'Win32 Msgbox');
}
} : _eval_or_throw q{
sub {
warn "messagebox only supported on Windows";
}
};
Then: $show_message->() to invoke this code. This avoids repeatedly compiling the same code with eval. Of course that only matters when this code is run more than once per script, e.g. inside a loop or in a subroutine.
I'm trying to export the methods written in my custom module using Exporter perl module. Below is my custom module ops.pm
use strict;
use warnings;
use Exporter;
package ops;
our #ISA= qw/Exporter/;
our #EXPORT=qw/add/;
our #EXPORT_OK=qw/mutliply/;
sub new
{
my $class=shift;
my $self={};
bless($self,$class);
return $self;
}
sub add
{
my $self=shift;
my $num1=shift;
my $num2=shift;
return $num1+$num2;
}
sub mutliply
{
my $self=shift;
my $num1=shift;
my $num2=shift;
return $num1*$num2;
}
1;
Below is the script ops_export.pl using ops.pm
#!/usr/bin/perl
use strict;
use warnings;
use ops;
my $num=add(1,2);
print "$num\n";
when i execute the above script i'm getting below error.
Undefined subroutine &main::add called at ops_export.pl line 8.
I'm not getting why my script is checking in &main package even though i have exported the add in ops.pm using #EXPORT
Where am i going wrong?
ops is a pragma already used by Perl. From the docs:
ops - Perl pragma to restrict unsafe operations when compiling
I don't know what that actually means but that's the issue here.
Rename your module to something else, preferably something with uppercase characters as #simbabque suggests in a comment, because lowercase "modules" are somehow reserved for pragmas (think of warnings or strict).
Also: Calling your add function won't work because you mix up OO code and regular functions. Your add expects three parameters and you supply only two (1 and 2).
When writing OO modules you shouldn't export anything (not even new), i.e.:
package Oops;
use strict; use warnings;
use OtherModules;
# don't mention 'Export' at all
sub new {
...
}
sub add {
...
}
1;
And then in your scripts:
use strict; use warnings;
use Oops;
my $calculator = Oops->new();
my $result = $calculator->add(1, 2);
print $result, "\n"; # gives 3
Having a C background, I may be trying to write something the wrong way so excuse the beginner question. Here is what I'm looking for :
I'm willing to have a perl module Verbose (not a class) that define a subroutine called verbose_print(). This subroutine will print its argument (a string) only if module's variable $verbose is true. Of course, what I'm willing to do is to get the -V option from the command line (using Getopt::Long) and then, is the -V switch is on, call the Verbose module with 'true' being the value for $Verbose::verbose.
One workaround is to have a verbose_init function that set the $Verbose::verbose variable to true inside the Verbose module.
Another one was to declare $verbose in my module using our and then $Verbose::verbose = $command_line_verbose_switch in the main script.
I was wondering if there is another way to do this in perl?
Don't be so afraid of classes in Perl, they're just packages and modules treated a wee bit differently. They don't bite. However, you said no classes, so no classes.
I prefer not to touch package variables directly. Instead, I'll use a subroutine to set them.
Here's my Local::Verbose (stored under Local/Verbose.pm)
package Local::Verbose;
use strict;
use warnings;
use Exporter 'import';
# Could have used just '#EXPORT', but that's bad manners
our #EXPORT_OK = qw(verbose verbose_switch);
# Use "our", so $verbose_value is a package variable.
# This makes it survive between calls to this package
our $verbose_value;
# prints out message, but only if $verbose_value is set to non-blank/zero value
sub verbose {
my $message = shift;
if ( $verbose_value ) {
print "VERBOSE: $message\n";
return $message;
}
else {
return;
}
}
sub verbose_switch {
my $switch_value = shift;
$verbose_value = $switch_value;
return $switch_value;
}
1;
Notice the our. That makes $verbose_value a package variable which means it lives on outside of the package between calls.
Notice how I use Exporter and the #EXPORT_OK array. You can use #EXPORT which will export all of the named subroutines automatically, but it's now considered bad manners since you could end up covering over someone's local subroutine with the same name. Better make it explicit. If there's a problem, they can use the Local::Verbose::verbose name of the verbose subroutine.
And how it's used
use strict;
use warnings;
use Local::Verbose qw(verbose verbose_switch);
verbose ("This is a test");
verbose_switch(1);
verbose ("This is a second test");
By the way, imagine calling the verbose subroutine like this:
verbose($message, $my_verbose_level);
Now, your verbose subroutine could look like this:
sub verbose {
my $message = shift;
my $verbose_level = shift;
if (not defined $verbose) {
$verbose_level = 1;
}
if ( $verbose_value =< $verbose_level ) {
print "VERBOSE: $message\n";
return $message;
}
else {
return;
}
}
Now, you can set your verbose level to various values, and have your verbose statements give you different levels of verbosity. (I do the same thing, but call it debug).
One of 'another ways' is create an import function:
package Verbose;
my $verbose_on;
sub import {
$verbose_on = shift;
}
#... Your code.
Now you can set your verbose like this:
if( ... ) { #check getopt
use Verbose (1); #This will require package Verbose and call "import"
}
But, i think more simple and obivious to further use is make a function-setter.
I wanted to use function reference for dynamically executing functions from other packages.
I have been trying different solutions for a while for the idea and nothing seemed to work!
So, i thought of asking this question and while attempting to do so, solution worked! but I'm not sure if it's the correct way to do so: it requires manual work and is a bit "hacky". Can it be improved?
A package to support required functionality
package Module;
# $FctHash is intended to be a Look-up table, on-reception
# of command.. execute following functions
$FctHash ={
'FctInitEvaluate' => \&FctInitEvaluate,
'FctInitExecute' => \&FctInitExecute
};
sub FctInitEvaluate()
{
//some code for the evalute function
}
sub FctInitExecute()
{
//some code for the execute function
}
1;
2. Utility Script needs to use the package using function reference
use strict;
use warnings 'all';
no strict 'refs';
require Module;
sub ExecuteCommand()
{
my ($InputCommand,#Arguments) =#_;
my $SupportedCommandRefenece = $Module::FctHash;
#verify if the command is supported before
#execution, check if the key is supported
if(exists($SupportedCommandRefenece->{$InputCommand}) )
{
// execute the function with arguments
$SupportedCommandRefenece->{$InputCommand}(#Arguments);
}
}
# now, evaluate the inputs first and then execute the function
&ExecuteCommand('FctInitEvaluate', 'Some input');
&ExecuteCommand('FctInitExecute', 'Some input');
}
But now, this technique seems to work! Still, is there a way to improve it?
You can use can. Please see perldoc UNIVERSAL for details.
use strict;
use warnings;
require Module;
sub ExecuteCommand {
my ($InputCommand, #Arguments) = #_;
if (my $ref = Module->can($InputCommand)) {
$ref->(#Arguments);
}
# ...
}
You've built a fairly standard implementation for using a hash as a dispatch table. If that's your intention, I don't seen any reason to do more than clean it up a little. can is a good alternative if you're attempting to build something OO-ish, but that's not necessary if all you're after is a command lookup table.
Here's a version that a) is runnable Perl as it stands (your attempt to mark comments with // in the question's version is a syntax error; in Perl, // is the 5.10-and-higher "defined-or" operator, not a comment marker) and b) has more of a perlish accent:
Module.pm
package Module;
use strict;
use warnings;
use 5.010;
our $function_lookup = {
FctInitEvaluate => \&init_evaluate,
FctInitExecute => \&init_execute,
};
sub init_evaluate {
say 'In init_evaluate';
}
sub init_execute {
say 'In init_execute';
}
1;
script.pl
#!/usr/bin/env perl
use strict;
use warnings;
require Module;
execute_command('FctInitEvaluate', 'Some input');
execute_command('FctInitExecute', 'Some input');
sub execute_command {
my ($input_command, #arguments) = #_;
$Module::function_lookup->{$input_command}(#arguments)
if exists($Module::function_lookup->{$input_command});
}