I want something like..
all_objects.pl
my $sub = $ARGV[1];
...
#objs = get_all_objects();
for my $obj (#objs) {
// invoke subroutine $sub with param as $obj.
}
now if I say
all_objects.pl "print 'x '"
all_objects.pl "print '$_ '"
I should get
obj1 obj2 obj3 ...
i.e. the command line arg act as a subroutine in some way. Can this be achieved?
eval "" is bad. Use something like the following, if it fulfills your needs:
my ($sub) = #ARGV;
my %prepared = (
print => sub { print "$_[0]\n" },
woof => sub { $_[0]->woof },
meow => sub { $_[0]->meow },
);
#objs = get_all_objects();
for my $obj (#objs) {
$prepared{$sub}->($obj);
}
Update: For debugging purposes, Perl has a debugger: perldoc perldebug
Eval is evil unless you really know what you're doing (think of it as an unshielded thermonuclear nuke -- sure you could handle one if you had to, and it might even save the world, but you'd be better off leaving it as a last resort, and let the nuclear physicists deal with it.)
You could put your all_objects.pl code into a module, and then use the module on the command line:
put this into AllObjects.pm:
package AllObjects;
use strict;
use warnings;
sub get_all_objects
{
# code here...
}
1;
Now on the command line:
perl -I. -MAllObjects -wle'for my $obj (AllObjects::get_all_objects()) { print "object is $obj" }'
However, it's not really clear what you are trying to achieve with the overall design.
You can read more about perl command-line invokation at perldoc perlrun, and making modules at perldoc perlmod (as well as many posts here on Stack Overflow).
Related
I'm just one-month experience in perl.
For perl-based program executing problem, the commend variable was returned to previous value.
What is the problem?
Here is the code.
1st();
2nd();
sub 1st {
$cmd = "cat asdf";
}
sub 2nd {
if ( $code =~ /aa/ ) {
my $cmd = "$reg $annotation";
out_log($cmd);
} else {
my $cmd = "$reg $annotation";
out_log($cmd);
}
out_log("$cmd");
open (Work,$cmd);
}
In this state, the $cmd was registered in if statement, but executing $cmd after if statement, the $cmd value was returned subroutine 1st's value.
Thanks for your advices.
You are mixing lexical and package variables. If your program had use strict and use warnings, this would be quite obvious.
If you do not declare a variable with my, Perl will assume it's a package variable. It will be visible from every part of your program (in the same namespace).
If you declare the variable with my, it will be lexical. That means that it only exists inside the scope it was created in.
my $foo = 1; #
#
if ($foo) { # #
my $bar = 2; # #
} # #
^ ^
| | scope that $foo exists in
| scope that $bar exists in
The same thing is happening here.
You are setting the package variable $::cmd (with :: being the main namespace) to "cat asdf" inside the 1st sub. You then call the 2nd sub, which will go into the else branch. In that scope, it will create a new lexical $cmd. It's only valid in that part of the program. It is then passed to out_log(), which probably prints it. Afterwards, you pass $::cmd with the "cat asdf" value to out_log(). At that point the new $cmd does not exist any more.
If you had use strict in your program, the program would not work at all, because the default package variable behavior is turned off in that case, so you have to define variables.
In fact you should not operate with package variables at all, but instead pass arguments to your functions.
In addition to that, there are a few other things that are not good practice in your program. You should use 3-argument open and a lexical filehandle, and also check the return value of open.
Names of functions cannot start with numbers, so 1st and 2nd are not valid names. It's better to name things after what they do or represent. That makes it easier to read your program later.
A full program might look like that.
use strict;
use warnings;
my ($code, $reg, $annotation); # these values come from somewhere...
run_cmd( compose_cmd(), $code, $reg, $annotation );
sub compose_cmd {
return "cat asdf";
}
sub run_cmd {
my ( $cmd, $code, $reg, $annotation ) = #_;
if ( $code =~ /aa/ ) {
my $cmd = "$reg $annotation";
out_log($cmd);
}
else {
my $cmd = "$reg $annotation";
out_log($cmd);
}
out_log("$cmd");
open my $fh, '<', $cmd or die $!;
# do stuff with $fh ...
}
sub out_log {
print #_;
}
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 don't know how to set default arguments for subroutines. Here is what I considered:
sub hello {
print #_ || "Hello world";
}
That works fine for if all you needed was one argument. How would you set default values for multiple arguments?
I was going to do this:
sub hello {
my $say = $_[0] || "Hello";
my $to = $_[1] || "World!";
print "$say $to";
}
But that's a lot of work... There must be an easier way; possibly a best practice?
I do it with named arguments like so:
sub hello {
my (%arg) = (
'foo' => 'default_foo',
'bar' => 'default_bar',
#_
);
}
I believe Params::Validate supports default values, but that's more trouble than I like to take.
I usually do something like:
sub hello {
my ($say,$to) = #_;
$say ||= "Hello";
$to ||= "World!";
print "$say $to\n";
}
Note that starting from perl 5.10, you can use the "//=" operator to test if the variable is defined, and not just non-zero. (Imagine the call hello("0","friend"), which using the above would yield "Hello friend", which might not be what you wanted. Using the //= operator it would yield "0 friend").
Also have a look at Method::Signatures. This uses Devel::Declare to provide some extra (needed!) sugar with the keywords method and func.
Below is your example using the new func:
use Method::Signatures;
func hello ($say='Hello', $to='World!') {
say "$say $to";
}
hello( 'Hello', 'you!' ); # => "Hello you!"
hello( 'Yo' ); # => "Yo World!"
hello(); # => "Hello World!"
/I3az/
If you see the documentation of Perl Best Practices: Default argument Values by Damian Conway then you will find some important points like:
Resolve any default argument values as soon as #_ is unpacked.
It suggest that if you have many default values to set up then the cleanest way would be factoring out the defaults into tables ie., a hash and then preinitializing the argument hash with that table.
Example:
#!/usr/bin/perl
use strict;
use warning;
my %myhash = (say => "Hello", to => "Stack Overflow");
sub hello {
my ($say, $to) = #_;
$say = $say ? $say : $myhash{say};
$to = $to ? $to : $myhash{to};
print "$say $to\n";
}
hello('Perl'); # output :Perl Stack Overflow
hello('','SO'); # output :Hello SO
hello('Perl','SO'); # output :Perl SO
hello(); # output :Hello Stack Overflow
For more detail and complete example refer Perl Best Practices.
Because Perl's mechanism for passing arguments to subroutines is a single list, arguments are positional. This makes it hard to provide default values. Some built-ins (e.g. substr) handle this by ordering arguments according to how likely they are to be used -- less frequently used arguments appear at the end and have useful defaults.
A cleaner way to do this is by using named arguments. Perl doesn't support named arguments per se, but you can emulate them with hashes:
use 5.010; # for //
sub hello {
my %arg = #_;
my $say = delete $arg{say} // 'Hello';
my $to = delete $arg{to} // 'World!';
print "$say $to\n";
}
hello(say => 'Hi', to => 'everyone'); # Hi everyone
hello(say => 'Hi'); # Hi world!
hello(to => 'neighbor Bob'); # Hello neighbor Bob
hello(); # Hello world!
Note: The defined-or operator // was added in Perl v5.10. It's more robust than using a logical or (||) as it won't default on the logically false values '' and 0.
I like this way the most: Since Perl 5.10 you can use // to check if a variable is defined or not and provide an alternative value in case it is not.
So, an easy example is:
my $DEFAULT_VALUE = 42;
sub f {
my ($p1, $p2) = #_;
$p1 //= 'DEFAULT';
$p2 // = $DEFAULT_VALUE;
}
Another option is using the shift instruction to get the params from #_:
sub f {
my $p1 = shift // 'DEFAULT';
}
Source: https://perlmaven.com/how-to-set-default-values-in-perl
There's the Attribute::Default module on CPAN. Probably cleaner than this, and avoids a couple of complexities (such as, what if you want to pass false to your subroutine?).
I've also seen people use my $var = exists #_[0] ? shift : "Default_Value";, but Perl's documentation notes that calling exists on arrays is deprecated, so I wouldn't really recommend it.
Snippet of Attribute::Default from the doc page:
sub vitals : Default({age => 14, sex => 'male'}) {
my %vitals = #_;
print "I'm $vitals{'sex'}, $vitals{'age'} years old, and am from $vitals{'location'}\n";
}
# Prints "I'm male, 14 years old, and am from Schenectady"
vitals(location => 'Schenectady');
The best way to address your problem have been discussed in the other answers.
One thing that strikes me though is that you state that:
sub hello {
print #_ || "Hello world";
}
And that works fine for if all you needed was one argument.
Have you actually tried that code? It will print the number of arguments or, when none provided, Hello World!
The reason for this is that the ||-operator takes precedence and forces the left-hand side in scalar context, thus reducing #_ to the number of arguments you provide, NOT the arguments itself!
have a look at perlop for more information on operators in Perl.
HTH,
Paul
For more sugar, see also Method::Signatures:
func add($this = 23, $that = 42) {
return $this + $that;
}
I'm trying to use Test::More to unit test Perl functions that print to the screen.
I understand that this output may interfere with tools such as prove.
How can I capture this output so I can print it with diag(), and also run tests on the output itself?
UPDATE: IMHO, the correct answer to this question ought to be to use Test::Output:
#!/usr/bin/perl
use strict; use warnings;
use Test::More tests => 1;
use Test::Output;
sub myfunc { print "This is a test\n" }
stdout_is(\&myfunc, "This is a test\n", 'myfunc() returns test output');
Output:
C:\Temp> tm
1..1
ok 1 - myfunc() returns test output
I am leaving the original answer for reference as, I believe, it still illustrates a useful technique.
You can localize STDOUT and reopen to a scalar before calling the function, restore afterward:
#!/usr/bin/perl
use strict; use warnings;
use Test::More tests => 1;
sub myfunc { print "This is a test\n" }
sub invoke {
my $sub = shift;
my $stdout;
{
local *STDOUT;
open STDOUT, '>', \$stdout
or die "Cannot open STDOUT to a scalar: $!";
$sub->(#_);
close STDOUT
or die "Cannot close redirected STDOUT: $!";
}
return $stdout;
}
chomp(my $ret = invoke(\&myfunc));
ok($ret eq "This is a test", "myfunc() prints test string" );
diag("myfunc() printed '$ret'");
Output:
C:\Temp> tm
1..1
ok 1 - myfunc() prints test string
# myfunc() printed 'This is a test'
For versions of perl older than 5.8, you probably need to use IO::Scalar, but I do not know much about how things worked before 5.8.
I'd look at letting a module handle this for you. Look at Capture::Tiny.
If this is code that you are writing yourself, change it so that the print statements don't use a default filehandle. Instead, give yourself a way to set the output filehandle to anything you like:
sub my_print {
my $self = shift;
my $fh = $self->_get_output_fh;
print { $fh } #_;
}
sub _get_output_fh { $_[0]->{_output} || \*STDOUT }
sub _set_output_fh { $_[0]->{_output} = $_[1] } # add validation yourself
When you test, you can call _set_output_fh to give it your testing filehandle (perhaps even an IO::Null handle). When another person wants to use your code but capture the output, they don't have to bend over backward to do it because they can supply their own filehandle.
When you find a part of your code that is hard to test or that you have to jump through hoops to work with, you probably have a bad design. I'm still amazed at how testing code makes these things apparent, because I often wouldn't think about them. If it's hard to test, make it easy to test. You generally win if you do that.
Requirement is to pass module name and function name from the command-line argument.
I need to get the command-line argument in the program and I need to call that function from that module
For example, calling a try.pl program with 2 arguments: MODULE1(Module name) Display(Function name)
perl try.pl MODULE1 Display
I want to some thing like this, but its not working, please guide me:
use $ARGV[0];
& $ARGV[0]::$ARGV[1]();
Assuming the function is not a class method, try this:
#!/usr/bin/perl
use strict;
use warnings;
my ( $package, $function ) = #ARGV;
eval "use $package (); ${package}::$function()";
die $# if $#;
Keep in mind that this technique is wide open to code injection. (The arguments could easily contain any Perl code instead of a module name.)
There's many ways to do this. One of them is:
#!/usr/bin/perl
use strict;
use warnings;
my ( $package, $function ) = #ARGV;
eval "use $package; 1" or die $#;
$package->$function();
Note the the first argument of the function will be $package.
Assuming the module exports the function, this should do:
perl -Mmodule -e function
If you want to make sure your perl script is secure (or at least, prevent yourself from accidentally doing something stupid), I'd avoid doing any kind of eval on data passed in to the script without at least some kind of checking. But, if you're doing some kind of checking anyway, and you end up explicitly checking the input, you might as well explicitly spell out witch methods you want to call. You could set up a hash with 'known good' methods, thus documenting everything that you want callable and protecting yourself at the same time.
my %routines = (
Module => {
Routine1 => \&Module::Method,
Routine2 => \&Module::Method2,
},
Module2 => {
# and so on
},
);
my $module = shift #ARGV;
my $routine = shift #ARGV;
if (defined $module
&& defined $routine
&& exists $routines{$module} # use `exists` to prevent
&& exists $routines{$module}{$routine}) # unnecessary autovivication
{
$routines{$module}{$routine}->(#ARGV); # with remaining command line args
}
else { } # error handling
As a neat side effect of this method, you can simply iterate through the methods available for any kind of help output:
print "Available commands:\n";
foreach my $module (keys %routines)
{
foreach my $routine (keys %$module)
{
print "$module::$routine\n";
}
}
As per Leon's, if the perl module doesn't export it, you can call it like so
perl -MMyModule -e 'MyModule::doit()'
provided that the sub is in that package.
If it exports the sub all the time (in #EXPORT), then Leon's will work:
perl -MMyModule -e doit
If it is an optional export (in #EXPORT_OK), then you can do it like this.
perl -MMyModule=doit -e doit
But the first will work in any case where the sub is defined to the package, and I'd probably use that one over the last one.
Always start your Perl like this:
use strict;
use warnings 'all';
Then do this:
no strict 'refs';
my ($class, $method) = #_;
(my $file = "$class.pm") =~ s/::/\//g;
require $file;
&{"$class\::$method"}();
Whatever you do, try not to eval "$string" ever.
Well, for your revised question, you can do this:
use strict;
use warnings;
{
no strict;
use Symbol qw<qualify>;
my $symb = qualify( $ARGV[1], $ARGV[0] );
unless ( defined &{$symb} ) {
die "&$ARGV[1] not defined to package $ARGV[0]\::";
}
&{$symb};
}
And because you're specifying it on the command line, the easiest way to include from the command line is the -M flag.
perl -MMyModule try.pl MyModule a_subroutine_which_does_something_cool
But you can always
eval "use $ARGV[0];";
But that's highly susceptible to injection:
perl try.pl "Carp; `do something disastrous`;" no_op
I'd use UNIVERSAL::require. It allows you to require or use a module from a variable. So your code would change to something like this:
use UNIVERSAL::require;
$ARGV[0]->use or die $UNIVERSAL::require::ERROR;
$ARGV[0]::$ARGV[1]();
Disclaimer: I did not test that code and I agree Robert P's comment about there probably being a better solution than passing these as command line arguments.