How can I add a function based on the version of perl? - perl

I'm sorry if this had been asked, but I found it hard to search for.
I use Perl 5.12 locally but some of our machines use Perl 5.8.8 and they won't be updated for the time being.
For auditing I use 'say' on platform 5.12.
I've written a simple function to implement say on 5.8.8 but I don't want to use it on 5.12.
Is there a way to only use my say function on the older version of Perl and use the 'builtin' version of say on 5.12?

You can use the $^V special variable to determine the version of the Perl interpreter:
BEGIN {
if ($^V ge v5.10.1) { # "say" first appeared in 5.10
require feature;
feature->import('say');
}
else {
*say = sub { print #_, "\n" }
}
}

This should work:
BEGIN{
no warnings 'once';
unless( eval{
require feature;
feature->import('say');
1
} ){
*say = sub{
print #_, "\n";
}
}
}

Related

Detect compile phase in Perl

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.

first time in perl OpenGL

awesome programmers.... im trying to studying perl opengl... i install all the modules and it went ok.. everythings fine! except for this...
my first code is
use OpenGL;
use SDL;
glpOpenWindow();
print "Return to exit\n";
while(<>){
exit;
}
and the result is
Goto undefined subroutine &AutoLoader::AUTOLOAD at C:/strawberry/perl/site/lib/OpenGL.pm line 6110.
i tried the test.pl of OpenGL.. awesomely works fine but this line of me is weird!
Below is the source code of method AUTOLOAD from OpenGL.pm
sub AUTOLOAD {
# This AUTOLOAD is used to 'autoload' constants from the constant()
# XS function. If a constant is not found then control is passed
# to the AUTOLOAD in AutoLoader.
# NOTE: THIS AUTOLOAD FUNCTION IS FLAWED (but is the best we can do for now).
# Avoid old-style ``&CONST'' usage. Either remove the ``&'' or add ``()''.
if (#_ > 0) {
# Is it an old OpenGL-0.4 function? If so, remap it to newer variant
local($constname);
($constname = $AUTOLOAD) =~ s/.*:://;
if (grep ($_ eq $constname, #rename_old)) {
eval "sub $AUTOLOAD { $AUTOLOAD" . "_s(\#_) }";
goto &$AUTOLOAD;
}
$AutoLoader::AUTOLOAD = $AUTOLOAD;
goto &AutoLoader::AUTOLOAD; #LINE 6110
}
They have put in comment that THIS AUTOLOAD FUNCTION IS FLAWED so maybe the warning you are getting is not due to your program but the problem with module itself.

How can I tell if used modules are pure perl?

If I have Perl code which usees a lot of modules, is there a fast and easy way to find out if some of this modules are not pure Perl modules?
#DynaLoader::dl_modules contains the list of XS modules loaded.
perl -MSome::Module1 -MSome::Module2 -M... \
-MDynaLoader -E'say for sort #DynaLoader::dl_modules;'
Or if you wanted to write it as a script:
# Usage: script Some::Module1 Some::Module2 ...
use 5.010;
use DynaLoader qw( );
while (defined($_ = shift(#ARGV))) {
s{::}{/}g;
$_ .= ".pm";
require $_;
}
say for sort #DynaLoader::dl_modules;
Of course, nothing's stopping you from putting it in an existing script either.
use 5.010;
use DynaLoader qw( );
END { say for sort #DynaLoader::dl_modules; }
This looks like a job for what I call a "blowup sensor". You could just boobytrap the hooks, by putting this at the top of the first module:
BEGIN {
require Carp; #Does the stack stuff
# Fool Perl into thinking that these are already loaded.
#INC{ 'XSLoader.pm', 'DynaLoader.pm' } = ( 1, 1 );
# overload boobytrapped stubs
sub XSLoader::load { Carp::confess( 'NOT Pure Perl!' ); }
sub DynaLoader::bootstrap { Carp::confess( 'NOT Pure Perl!' ); }
}
If you have to try which modules in your Perl prog is not installed yet on your machine. You can do it like this:
use ExtUtils::Installed;
my $installed = ExtUtils::Installed->new();
my #miss;
foreach $module ($installed->modules()){
#miss = $installed->validate($module);
}
print join("\n", #miss);

How to execute functions from packages using function reference in perl?

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});
}

How do I check whether a Perl module is installed? [duplicate]

This question already has answers here:
How can I require an optional Perl module if installed?
(8 answers)
Closed 9 years ago.
I'm writing a small Perl script that depends on some modules that might be available, so during the installation I would have to check if everythings there. I could just write use some::module and see if an error comes up, but a short message like "You need to install some::module" would be more helpful for endusers.
I also could just search every directory in #INC, but as it's Perl, there has to be an easier way.
perl -MSome::Module -e ';'
Whoops, misread the question. I thought you wanted to know in a one-off instance, not discovering it in a recoverable manner. I always use something like this:
sub try_load {
my $mod = shift;
eval("use $mod");
if ($#) {
#print "\$# = $#\n";
return(0);
} else {
return(1);
}
}
Which you use like this:
$module = 'Some::Module';
if (try_load($module)) {
print "loaded\n";
} else {
print "not loaded\n";
}
How about:
die "Some::Module missing!" unless(eval{require Some::Module});
I have a little script that lists all the Perl modules on my system;
#!/usr/bin/perl
use ExtUtils::Installed;
my $instmod = ExtUtils::Installed->new();
foreach my $module ($instmod->modules()) {
my $version = $instmod->version($module) || "???";
print "$module -- $version\n";
}
Inside that foreach loop you might want to do some thing like;
my $match;
if ($module =~ /$match/) {
print "Found $match: $module\n";
}
I use something like this:
BEGIN {
my $module_name = shift; # #ARGV
our $module_exp = $module_name;
eval "use $module_name;";
}
$module_exp =~ s{::}{/}g;
foreach my $key ( grep { m/^$module_exp\./ } keys %INC ) {
print "$key => $INC{$key}\n";
}
But I use this more in the form of a korn shell function:
function wherperl
{
perl -M$1 <<EX_DOC
my \$module = '$1';
\$module =~ s/::/\\//g;
for ( keys %INC ) {
next unless m/^\$module\./;
print \$_ . ' => ' . \$INC{\$_} . "\n";
}
EX_DOC
}
I like to use the cpan utility:
% cpan -D YAML
YAML
-------------------------------------------------------------------------
YAML Ain't Markup Language (tm)
A/AD/ADAMK/YAML-0.70.tar.gz
/usr/local/perls/perl-5.10.0/lib/site_perl/5.10.0/YAML.pm
Installed: 0.68
CPAN: 0.70 Not up to date
Ingy dot Net (INGY)
ingy#cpan.org
This can be a little slow since it has to connect to a CPAN mirror to fetch some of the data, but I also have a local CPAN mirror. :)