I'm looking for a way to do this in Perl:
$a = "60"; $b = "< 80";
if ( $a $b ) { then .... }
Here, $b "holds" an operator... can I do this? Maybe some other way?
It's nice to see how people discover functional programming. :-)
Luckily, Perl has capabilities to create and store functions on-the-fly. For example, the sample in your question will look like this:
$a = "60"; $b = sub { $_[0] < 80 };
if ( $b->($a) ) { .... }
In this example, a reference to the anonymous subroutine is stored in $b, the sub having the same syntax for argument passing as a usual one. -> is then used to call-by-reference (the same syntax you probably use for references to arrays and hashes).
But, of course, if you want just to construct Perl expressions from arbitrary strings, you might want to use eval:
$a = "60"; $b = " < 80";
if ( eval ("$a $b") ) { .... }
However, doing this via eval is not safe, if the string you're eval-ing contains parts that come as user input. Sinan Ünür explained it perfectly in his answer-comment.
How about defining a function that wraps the needed condition:
my $cond = sub { $_[0] < 80 };
if ( $cond->( $a ) ) {
...
}
This should be a comment but comments are too cramped for something like this so I am making it CW.
For the case which you showed where the contents of the variables that are going to be passed to string eval, the accepted solution is correct.
If, however, the contents of $a and $b come from user input, then take a look at the following script:
#!/usr/bin/perl
use strict; use warnings;
my $x = '80';
my $y = '; warn "evil laugh!\n"; exit';
if ( eval ($x . $y) ) {
print "it worked!!!\n";
}
If the strings are entered by the user, there is nothing preventing the user from passing to your program the string ';system "rm -rf /bin"'.
So, the correct solution to your question would require writing or using an expression parser.
BTW, you should not use $a and $b as variable names as the are magical package local variables used by sort and as such they are exempt from strict — and you must always use strict and warnings in your programs.
$a = "60"; $b = "< 80";
if( eval($a. $b)){
print "ok";
}
see perldoc eval for more
I wonder if Number::Compare is of any interest here. From the example:
Number::Compare->new(">1Ki")->test(1025); # is 1025 > 1024
my $c = Number::Compare->new(">1M");
$c->(1_200_000); # slightly terser invocation
Safer form if you trust (or can sufficiently validate) $op and don't trust the safety of the inputs:
my $compare_x = $user_input_x;
my $compare_y = $user_input_y;
my $op = <some safe non-user-input, or otherwise checked against a safe list>;
if ( eval("\$compare_x $op \$compare_y") )
{
...
}
Related
I am initializing a variable within one function and would like to pass this variable into another function. This variable holds a char value.
I have tried passing in the referencing and dereferencing, declaring the variables outside of the function, and using local.
I've also looked in perlmonks, perl by example, googled and looked through this site for a solution but to no avail. I'm just starting out with perl programming so any help will be appreciated!
Sounds to me like you need to read through some documentation, not just google around. I would suggest http://www.perl.org/books/beginning-perl/.
use strict;
use warnings;
sub foo {
my $char = 'A';
bar($char);
}
sub bar {
my ($bar_char) = #_;
print "bar got char $bar_char\n";
}
foo();
If you pass a parameter by reference (see below), it can be modified by the first function and you can then pass it to another function:
#!/usr/bin/perl
sub f {
$c = shift;
$$c='m';
}
$c='a';
f(\$c);
print $c;
This will print 'm'
Is there a reason who your first function cannot return this variable?
my $config_variable = function1( $param1 );
function2 ( $config_variable, $param2 );
You can also pass more than one variable back too:
my ( $config_variable, $value ) = function1( $param1 );
my $value2 = function2( $param1, $config_variable );
This would be the best way. However, you can use globally defined variables and they can be used from function to function:
#! /usr/bin/env perl
#
use strict;
use warnings;
my $value;
func1();
func2();
sub func1 {
$value = "foo";
}
sub func2 {
print "Value = $value\n";
}
Note that I declared $value outside of both functions, so it's global in the entire file - even in the subroutines. Now, func1 can set it, and func1 can print it.
The technical term for this is: A terrible, awful, evil idea and you should never, ever1 think of doing it.
This is because a particular variable you think is set to one value suddenly and mysteriously changes values without any reason. Do this for one variable is bad enough, but if you use this as a crutch, you'll end up with dozens of variables that are impossible to track through your program.
If you find yourself doing this quite a bit, you may need to rethink your code logic.
I'm just starting in Perl and I'm quite enjoying it. I'm writing some basic functions, but what I really want to be able to do is to use those functions intelligently using console commands. For example, say I have a function adding two numbers. I'd want to be able to type in console "add 2, 4" and read the first word, then pass the two numbers as parameters in an "add" function. Essentially, I'm asking for help in creating some basic scripting using Perl ^^'.
I have some vague ideas about how I might do this in VB, but Perl, I have no idea where I'd start, or what functions would be useful to me. Is there something like VB.net's "Split" function where you can break down the contents of a scalar into an array? Is there a simple way to analyse one word at a time in a scalar, or iterate through a scalar until you hit a separator, for example?
I hope you can help, any suggestions are appreciated! Bear in mind, I'm no expert, I started Perl all of a few weeks ago, and I've only been doing VB.net half a year.
Thank you!
Edit: If you're not sure what to suggest and you know any simple/intuitive resources that might be of help, that would also be appreciated.
Its rather easy to make a script which dispatches to a command by name. Here is a simple example:
#!/usr/bin/env perl
use strict;
use warnings;
# take the command name off the #ARGV stack
my $command_name = shift;
# get a reference to the subroutine by name
my $command = __PACKAGE__->can($command_name) || die "Unknown command: $command_name\n";
# execute the command, using the rest of #ARGV as arguments
# and print the return with a trailing newline
print $command->(#ARGV);
print "\n";
sub add {
my ($x, $y) = #_;
return $x + $y;
}
sub subtract {
my ($x, $y) = #_;
return $x - $y;
}
This script (say its named myscript.pl) can be called like
$ ./myscript.pl add 2 3
or
$ ./myscript.pl subtract 2 3
Once you have played with that for a while, you might want to take it further and use a framework for this kind of thing. There are several available, like App::Cmd or you can take the logic shown above and modularize as you see fit.
You want to parse command line arguments. A space serves as the delimiter, so just do a ./add.pl 2 3 Something like this:
$num1=$ARGV[0];
$num2=$ARGV[1];
print $num1 + $num2;
will print 5
Here is a short implementation of a simple scripting language.
Each statement is exactly one line long, and has the following structure:
Statement = [<Var> =] <Command> [<Arg> ...]
# This is a regular grammar, so we don't need a complicated parser.
Tokens are seperated by whitespace. A command may take any number of arguments. These can either be the contents of variables $var, a string "foo", or a number (int or float).
As these are Perl scalars, there is no visible difference between strings and numbers.
Here is the preamble of the script:
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
strict and warnings are essential when learning Perl, else too much weird stuff would be possible. The use 5.010 is a minimum version, it also defines the say builtin (like a print but appends a newline).
Now we declare two global variables: The %env hash (table or dict) associates variable names with their values. %functions holds our builtin functions. The values are anonymous functions.
my %env;
my %functions = (
add => sub { $_[0] + $_[1] },
mul => sub { $_[0] * $_[1] },
say => sub { say $_[0] },
bye => sub { exit 0 },
);
Now comes our read-eval-loop (we don't print by default). The readline operator <> will read from the file specified as the first command line argument, or from STDIN if no filename is provided.
while (<>) {
next if /^\s*\#/; # jump comment lines
# parse the line. We get a destination $var, a $command, and any number of #args
my ($var, $command, #args) = parse($_);
# Execute the anonymous sub specified by $command with the #args
my $value = $functions{ $command }->(#args);
# Store the return value if a destination $var was specified
$env{ $var } = $value if defined $var;
}
That was fairly trivial. Now comes some parsing code. Perl “binds” regexes to strings with the =~ operator. Regexes may look like /foo/ or m/foo/. The /x flags allows us to include whitespace in our regex that doesn't match actual whitespace. The /g flag matches globally. This also enables the \G assertion. This is where the last successful match ended. The /c flag is important for this m//gc style parsing to consume one match at a time, and to prevent the position of the regex engine in out string to being reset.
sub parse {
my ($line) = #_; # get the $line, which is a argument
my ($var, $command, #args); # declare variables to be filled
# Test if this statement has a variable declaration
if ($line =~ m/\G\s* \$(\w+) \s*=\s* /xgc) {
$var = $1; # assign first capture if successful
}
# Parse the function of this statement.
if ($line =~ m/\G\s* (\w+) \s*/xgc) {
$command = $1;
# Test if the specified function exists in our %functions
if (not exists $functions{$command}) {
die "The command $command is not known\n";
}
} else {
die "Command required\n"; # Throw fatal exception on parse error.
}
# As long as our matches haven't consumed the whole string...
while (pos($line) < length($line)) {
# Try to match variables
if ($line =~ m/\G \$(\w+) \s*/xgc) {
die "The variable $1 does not exist\n" if not exists $env{$1};
push #args, $env{$1};
}
# Try to match strings
elsif ($line =~ m/\G "([^"]+)" \s*/xgc) {
push #args, $1;
}
# Try to match ints or floats
elsif ($line =~ m/\G (\d+ (?:\.\d+)? ) \s*/xgc) {
push #args, 0+$1;
}
# Throw error if nothing matched
else {
die "Didn't understand that line\n";
}
}
# return our -- now filled -- vars.
return $var, $command, #args;
}
Perl arrays can be handled like linked list: shift removes and returns the first element (pop does the same to the last element). push adds an element to the end, unshift to the beginning.
Out little programming language can execute simple programs like:
#!my_little_language
$a = mul 2 20
$b = add 0 2
$answer = add $a $b
say $answer
bye
If (1) our perl script is saved in my_little_language, set to be executable, and is in the system PATH, and (2) the above file in our little language saved as meaning_of_life.mll, and also set to be executable, then
$ ./meaning_of_life
should be able to run it.
Output is obviously 42. Note that our language doesn't yet have string manipulation or simple assignment to variables. Also, it would be nice to be able to call functions with the return value of other functions directly. This requires some sort of parens, or precedence mechanism. Also, the language requires better error reporting for batch processing (which it already supports).
strftime(), as per cpan.org:
print strftime($template, #lt);
I just can't figure the right Perl code recipe for this one. It keeps reporting an error where I call strftime():
...
use Date::Format;
...
sub parse_date {
if ($_[0]) {
$_[0] =~ /(\d{4})/;
my $y = $1;
$_[0] =~ s/\d{4}//;
$_[0] =~ /(\d\d)\D(\d\d)/;
return [$2,$1,$y];
}
return [7,7,2010];
}
foreach my $groupnode ($groupnodes->get_nodelist) {
my $groupname = $xp->find('name/text()', $groupnode);
my $entrynodes = $xp->find('entry', $groupnode);
for my $entrynode ($entrynodes->get_nodelist) {
...
my $date_added = parse_date($xp->find('date_added/text()', $entrynode));
...
$groups{$groupname}{$entryname} = {...,'date_added'=>$date_added,...};
...
}
}
...
my $imday = $maxmonth <= 12 ? 0 : 1;
...
while (my ($groupname, $entries) = each %groups) {
...
while (my ($entryname, $details) = each %$entries) {
...
my $d = #{$details->{'date_added'}};
$writer->dataElement("creation", strftime($date_template, (0,0,12,#$d[0^$imday],#$d[1^$imday]-1,#$d[2],0,0,0)));
}
...
}
...
If I use () to pass the required array by strftime(), I get:
Type of arg 2 to Date::Format::strftime must be array (not list) at ./blah.pl line 87, near "))"
If I use [] to pass the required array, I get:
Type of arg 2 to Date::Format::strftime must be array (not anonymous list ([])) at ./blah.pl line 87, near "])"
How can I pass an array on the fly to a sub in Perl? This can easily be done with PHP, Python, JS, etc. But I just can't figure it with Perl.
EDIT: I reduced the code to these few lines, and I still got the exact same problem:
#!/usr/bin/perl
use warnings;
use strict;
use Date::Format;
my #d = [7,13,2010];
my $imday = 1;
print strftime( q"%Y-%m-%dT12:00:00", (0,0,12,$d[0^$imday],$d[1^$imday]-1,$d[2],0,0,0));
Where an array is required and you have an ad hoc list, you need to actually create an array. It doesn't need to be a separate variable, you can do just:
strftime(
$date_template,
#{ [0,0,12,$d[0^$imday],$d[1^$imday],$d[2],0,0,0] }
);
I have no clue why Date::Format would subject you to this hideousness and not just expect multiple scalar parameters; seems senseless (and contrary to how other modules implement strftime). Graham Barr usually designs better interfaces than this. Maybe it dates from when prototypes still seemed like a cool idea for general purposes.
To use a list as an anonymous array for, say, string interpolation, you could write
print "#{[1, 2, 3]}\n";
to get
1 2 3
The same technique provides a workaround to Date::Format::strftime's funky prototype:
print strftime(q"%Y-%m-%dT12:00:00",
#{[0,0,12,$d[0^$imday],$d[1^$imday]-1,$d[2],0,0,0]});
Output:
1900-24709920-00T12:00:00
Normally, it is easy to pass arrays "on-the-fly" to Perl subroutines. But Date::Format::strftime is a special case with a special prototype ($\#;$) that doesn't allow "list" arguments or "list assignment" arguments:
strftime($format, (0,0,12,13,7-1,2010-1900)); # not ok
strftime($format, #a=(0,0,12,13,7-1,2010-1900)); # not ok
The workaround is that you must call strftime with an array variable.
my #time = (0,0,12,13,7-1,2010-1900); # note: #array = ( ... ), not [ ... ]
strftime($format, #time);
I looked again and I see the real problem in this code:
my $d = #{$details->{'date_added'}};
$writer->dataElement("creation", strftime($date_template, (0,0,12,#$d[0^$imday],#$d[1^$imday]-1,#$d[2],0,0,0)));
Specifically #{$details->{'date_added'}} is a dereference. But you're assigning it to a scalar variable and you don't need to dereference in the line below it:
my #d = #{$details->{'date_added'}};
$writer->dataElement("creation", strftime($date_template, (0,0,12,$d[0^$imday],$d[1^$imday]-1,$d[2],0,0,0)));
I've created a regular array for your reference #d and just accessed it as a regular array ( $d[ ... ] instead of #$d[ ... ] )
So, building off a question about string matching (this thread), I am working on implementing that info in solution 3 into a working solution to the problem I am working on.
However, I am getting errors, specifically about this line of the below function:
next if #$args->{search_in} !~ /#$cur[1]/;
syntax error at ./db_index.pl line 16, near "next "
My question as a perl newbie is what am I doing wrong here?
sub search_for_key
{
my ($args) = #_;
foreach $row(#{$args->{search_ary}}){
print "#$row[0] : #$row[1]\n";
}
my $thiskey = NULL;
foreach $cur (#{$args->{search_ary}}){
print "\n" . #$cur[1] . "\n"
next if #$args->{search_in} !~ /#$cur[1]/;
$thiskey = #$cur[0];
last;
}
return $thiskey;
}
You left off the semicolon at the end of the previous line. That's what caused the syntax error, anyway. I think you're also misusing $args, but it's hard to be sure about that without knowing how you're calling this function.
There are several issues here.
Are you adding use strict; and use warnings; at the top of your script before you do anything else? You only posted the sub, but it is clear that you are not using these.
What is NULL? (strict will not let you use bare-words...) Be sure to read What is Truth in Perl? The more Perly way is to deal with "truth" or "false" is defined / undef or exists or specifically test for a value chosen as a convention.
Missing ; after print "\n" . #$cur[1] . "\n"
Your data structures seem way too complicated. From what I can tell, you are passing a reference to a hash of arrays, true? Why your data structures get really obscure, back up and look at what you are trying to do...
Perl gives you plenty of way to shoot yourself in the foot. It is not strictly typed and you will do yourself (and your readers) a favor by naming references as a derivative of what they refer to. So instead of $args use $ref2HoArefs for example.
Side note, are you sure you can't just use a hash for what you're doing? It seems awfully complicated do do something so simple:
my %hash = (
key1 => 'value1',
key2 => 'value2',
);
exists $hash{$search_in}; # true/false.
my $result = $hash{$search_in}; # returns 'value1' when $search_in is 'key1'
Or if you need to search by value:
my %flip = reverse %hash;
$result = $flip{$search_in};
And if you really need a regex key ( or value ) lookup:
sub string_match {
my ($lookup_hash, $key ) = #_;
for my $hash_key ( %{ $lookup_hash } ){
return $hash_key if $key =~ $lookup_hash->{$hash_key};
}
return; # not found.
}
my $k = string_match({
'whitespace at end' => qr/\s+$/,
'whitespace at start' => qr/^\s+/,
}, "Some Garbage string "); # k == whitespace at end
I currently use the following Perl to check if a variable is defined and contains text. I have to check defined first to avoid an 'uninitialized value' warning:
if (defined $name && length $name > 0) {
# do something with $name
}
Is there a better (presumably more concise) way to write this?
You often see the check for definedness so you don't have to deal with the warning for using an undef value (and in Perl 5.10 it tells you the offending variable):
Use of uninitialized value $name in ...
So, to get around this warning, people come up with all sorts of code, and that code starts to look like an important part of the solution rather than the bubble gum and duct tape that it is. Sometimes, it's better to show what you are doing by explicitly turning off the warning that you are trying to avoid:
{
no warnings 'uninitialized';
if( length $name ) {
...
}
}
In other cases, using some sort of null value instead of the actual data gets around the problem. With Perl 5.10's defined-or operator, give length an explicit empty string (defined, and gives back zero length) instead of the variable that would trigger the warning:
use 5.010;
if( length( $name // '' ) ) {
...
}
In Perl 5.12, it's a bit easier because length on an undefined value also returns undefined. That might seem like a bit of silliness, but that pleases the mathematician I might have wanted to be. That doesn't issue a warning, which is the reason this question exists.
use 5.012;
use warnings;
my $name;
if( length $name ) { # no warning
...
}
As mobrule indicates, you could use the following instead for a small savings:
if (defined $name && $name ne '') {
# do something with $name
}
You could ditch the defined check and get something even shorter, e.g.:
if ($name ne '') {
# do something with $name
}
But in the case where $name is not defined, although the logic flow will work just as intended, if you are using warnings (and you should be), then you'll get the following admonishment:
Use of uninitialized value in string ne
So, if there's a chance that $name might not be defined, you really do need to check for definedness first and foremost in order to avoid that warning. As Sinan Ünür points out, you can use Scalar::MoreUtils to get code that does exactly that (checks for definedness, then checks for zero length) out of the box, via the empty() method:
use Scalar::MoreUtils qw(empty);
if(not empty($name)) {
# do something with $name
}
First, since length always returns a non-negative number,
if ( length $name )
and
if ( length $name > 0 )
are equivalent.
If you are OK with replacing an undefined value with an empty string, you can use Perl 5.10's //= operator which assigns the RHS to the LHS unless the LHS is defined:
#!/usr/bin/perl
use feature qw( say );
use strict; use warnings;
my $name;
say 'nonempty' if length($name //= '');
say "'$name'";
Note the absence of warnings about an uninitialized variable as $name is assigned the empty string if it is undefined.
However, if you do not want to depend on 5.10 being installed, use the functions provided by Scalar::MoreUtils. For example, the above can be written as:
#!/usr/bin/perl
use strict; use warnings;
use Scalar::MoreUtils qw( define );
my $name;
print "nonempty\n" if length($name = define $name);
print "'$name'\n";
If you don't want to clobber $name, use default.
In cases where I don't care whether the variable is undef or equal to '', I usually summarize it as:
$name = "" unless defined $name;
if($name ne '') {
# do something with $name
}
You could say
$name ne ""
instead of
length $name > 0
It isn't always possible to do repetitive things in a simple and elegant way.
Just do what you always do when you have common code that gets replicated across many projects:
Search CPAN, someone may have already the code for you. For this issue I found Scalar::MoreUtils.
If you don't find something you like on CPAN, make a module and put the code in a subroutine:
package My::String::Util;
use strict;
use warnings;
our #ISA = qw( Exporter );
our #EXPORT = ();
our #EXPORT_OK = qw( is_nonempty);
use Carp qw(croak);
sub is_nonempty ($) {
croak "is_nonempty() requires an argument"
unless #_ == 1;
no warnings 'uninitialized';
return( defined $_[0] and length $_[0] != 0 );
}
1;
=head1 BOILERPLATE POD
blah blah blah
=head3 is_nonempty
Returns true if the argument is defined and has non-zero length.
More boilerplate POD.
=cut
Then in your code call it:
use My::String::Util qw( is_nonempty );
if ( is_nonempty $name ) {
# do something with $name
}
Or if you object to prototypes and don't object to the extra parens, skip the prototype in the module, and call it like: is_nonempty($name).
The excellent library Type::Tiny provides an framework with which to build type-checking into your Perl code. What I show here is only the thinnest tip of the iceberg and is using Type::Tiny in the most simplistic and manual way.
Be sure to check out the Type::Tiny::Manual for more information.
use Types::Common::String qw< NonEmptyStr >;
if ( NonEmptyStr->check($name) ) {
# Do something here.
}
NonEmptyStr->($name); # Throw an exception if validation fails
How about
if (length ($name || '')) {
# do something with $name
}
This isn't quite equivalent to your original version, as it will also return false if $name is the numeric value 0 or the string '0', but will behave the same in all other cases.
In perl 5.10 (or later), the appropriate approach would be to use the defined-or operator instead:
use feature ':5.10';
if (length ($name // '')) {
# do something with $name
}
This will decide what to get the length of based on whether $name is defined, rather than whether it's true, so 0/'0' will handle those cases correctly, but it requires a more recent version of perl than many people have available.
if ($name )
{
#since undef and '' both evaluate to false
#this should work only when string is defined and non-empty...
#unless you're expecting someting like $name="0" which is false.
#notice though that $name="00" is not false
}