Use of uninitialised value $d in division {/} at - perl

So I've done some googling and other site, my console is filled with all these warnings. Just a bit unsure how to fix this method overall. Likewise I hope my code isn't vague since I'm not too sure if the code here is enough. Regardless here is the issue. I have been trying to integrate a Perl script within my module for a while. The script itself works but not in the module. The error message for when I try to run it is this method:
sub generate_pillars_shape{
my $d=$_[4];
#X_values=$_[0]/$d..$_[1]/$d;
#X_values=map{$_*$d} #X_values;
#Y_values=$_[2]/$d..$_[3]/$d;
#Y_values=map{$_*$d} #Y_values;
for $i (0..$#X_values){
#Y=(#Y,#Y_values);
for $j (0..$#Y_values){
$X[$i*($#Y_values+1)+$j]= $X_values[$i];
}
}
return (\#X,\#Y);
}
The entire code consists of this:
use 5.010;
use Math::Trig ':radial';
use Math::Trig;
use List::Util qw(max min);
my $min_X=0;
my $max_X=60;
my $min_Y=0;
my $max_Y=60;
my $distance=10;
my #X_values;
my #Y_values;
my $i;
my $j;
#The minimum angle from horizontl your printer can make, in degrees
my $min_angle= 30;
#Ignore the next line, it is not an input parame
my #Z;
my ($X_ref,$Y_ref)= generate_pillars_shape($min_X,$max_X,$min_Y,$max_Y,$distance);my #X=#$X_ref;my #Y=#{$Y_ref};
for my $i (0..$#X){
$Z[$i]=20;#The function that defined the height of each point. This setting wil give you a flat roof. For a more advanced tree, try:
#$Z[$i]=-0.01*$X[$i]**2+0.2*$Y[$i]-0.005*$Y[$i]**2+20;
}
#End of input parameters.
my $min_radian = deg2rad($min_angle);
my $b = tan($min_radian);
#Z=map{$_/$b} #Z;
while ($#X>0){
my ($I,$J)=find_min_dist(\#X,\#Y,\#Z);
my ($X_branch,$Y_branch,$Z_branch)=find_branch($X[$I],$Y[$I],$Z[$I],$X[$J],$Y[$J],$Z[$J]);
my #X_list= ($X_branch,$X[$I],$X[$J]);
my #Y_list= ($Y_branch,$Y[$I],$Y[$J]);
my #Z_list= ($Z_branch,$Z[$I],$Z[$J]);
for my $j (0..$#Y_list){
if (abs($X_list[my $j]) < 0.001){
$X_list[$j]=0;
}
if (abs($Y_list[my $j]) < 0.001){
$Y_list[$j]=0;
}
if (abs($Z_list[my $j]) < 0.001){
$Z_list[$J]=0;
}
}
branch (\#X_list,\#Y_list,\#Z_list);
splice (#X,$I,1,$X_branch);
splice (#X,$J,1);
splice (#Y,$I,1,$Y_branch);
splice (#Y,$J,1);
splice (#Z,$I,1,$Z_branch);
splice (#Z,$J,1);
}
sub generate_pillars_shape{
my $d=$_[4];
#X_values=$_[0]/$d..$_[1]/$d;
#X_values=map{$_*$d} #X_values;
#Y_values=$_[2]/$d..$_[3]/$d;
#Y_values=map{$_*$d} #Y_values;
for $i (0..$#X_values){
#Y=(#Y,#Y_values);
for $j (0..$#Y_values){
$X[$i*($#Y_values+1)+$j]= $X_values[$i];
}
}
return (\#X,\#Y);
}
sub branch{
my #X=#{ $_[0] };
my #Y=#{ $_[1] };
my #Z=#{ $_[2] };
#Z=map{$_*$b}#Z;
for my $i (1..$#X){
my ($rho, $theta, $phi) = cartesian_to_spherical($X[$i]-$X[0],$Y[$i]-$Y[0],$Z[$i]-$Z[0]);
$phi = rad2deg($phi);
if (abs($phi)<0.001){$phi=0;}
$theta = rad2deg($theta)+90;
if (abs($theta)<0.001){$theta=0;}
if (abs($rho)>0.001){}
}
}
sub find_min_dist{
my #X=#{ $_[0] };
my #Y=#{ $_[1] };
my #Z=#{ $_[2] };
my $min_dist=($X[0]-$X[1])**2+($Y[0]-$Y[1])**2+($Z[0]-$Z[1])**2;
my $max_Z=$Z[0];
my $I=0;
my $J=1;
for my $i (1..$#Z){
if ($Z[$i]>=$max_Z){
$max_Z=$Z[$i];
my $I=$i;}
}
for my $j (0..$#X){
if ($j!=$I){
my $dist=(($X[$I]-$X[$j])**2+($Y[$I]-$Y[$j])**2+($Z[$I]-$Z[$j])**2);
if ($min_dist>$dist){
$min_dist=$dist;
my $J=$j;
}}}
return ($I,$J);
}
sub find_branch{
my $X1=$_[0];
my $Y1=$_[1];
my $Z1=$_[2];
my $X2=$_[3];
my $Y2=$_[4];
my $Z2=$_[5];
my $rXY=sqrt(($X1-$X2)**2+($Y1-$Y2)**2);
if (abs($Z1-$Z2) < $rXY) {
my $Z_branch=($Z1+$Z2-$rXY)/2;
my $a=($Z1-$Z_branch)/$rXY;
my $X_branch=(1-$a)*$X1+$a*$X2;
my $Y_branch=(1-$a)*$Y1+$a*$Y2;
}
elsif ($Z1 < $Z2) {
my $X_branch=$X1;
my $Y_branch=$Y1;
my $Z_branch=$Z1;
}
else {
my $X_branch=$X2;
my $Y_branch=$Y2;
my $Z_branch=$Z2;
}
return my($X_branch,$Y_branch,$Z_branch);
}
I hope that explains the general situation, any help would be appreciated. Thanks.

I can't reproduce your error. However, there are a lot of errors in your code, so let me go through them, and hopefully this will help you find your actual mistake.
First, variables should be defined in the smallest possible scope: if a variable is used only within a function, it should be defined within this function. If a variable is used only in a for loop, it should be defined within this loop. In that spirit, you should remove
my $i;
my $j;
at the begining of your code. Also, keep in mind that my declares a lexical variable visible only in the current scope (ie. you can use it only in the current block). For instance,
else {
my $X_branch=$X2;
my $Y_branch=$Y2;
my $Z_branch=$Z2;
}
declares 3 variables that don't exist after the else block.
Second, my declares a new variable, and should therefore be used only once per variable. If you write
my $x = 5;
return my $x;
The first line declares a variable $x, and set it to 5. The second line declares a new variable $x (thus shadowing the old one), whose value is undef, and returns it. What you want to write instead is:
my $x = 5;
return $x;
Now let me go through your code to point out a few mistakes/improvements:
$X_list[my $j] should be $X_list[$j] (as per the beginning of this answer).
Still in find_branch, you have an issue with the scope of the variables you defined (see the beginning of my answer). You should have something like:
my ($X_branch, $Y_branch, $Z_branch);
if (abs($Z1-$Z2) < $rXY) {
$Z_branch=($Z1+$Z2-$rXY)/2;
my $a=($Z1-$Z_branch)/$rXY;
$X_branch=(1-$a)*$X1+$a*$X2;
$Y_branch=(1-$a)*$Y1+$a*$Y2;
}
elsif ($Z1 < $Z2) {
$X_branch=$X1;
$Y_branch=$Y1;
$Z_branch=$Z1;
}
else {
$X_branch=$X2;
$Y_branch=$Y2;
$Z_branch=$Z2;
}
return ($X_branch,$Y_branch,$Z_branch);
This two corrections should silence every warnings. However, I suspect there are more things going wrong in your code.
In find_min_dist, you should not write my $I = $i and my $J = $j but rather $I = $i and $J = $j (still the same scoping issue).
Your sub branch doesn't do anything: you compute some $rho, $theta and $phi, but you don't return them (and you don't modify the arguments either).
In generate_pillars_shape, #X_values, #Y_values, #X, #Y should all be locally declared with my. Also, you can initialize #X_values with #X_values = grep { $_ % $d == 0 } $_[0] .. $_[1] (same for #Y_values), which I find more readable that what you wrote.
You should put your code in functions or code blocks ({ ... }) to use proper scoping: while it can make sense to have $min_X, $max_X, $min_Y, $max_Y,and $distance as global variables, you definitely don't want to have $min_radian or $b defined everywhere in your file.
Don't use $a or $b (they are special variables, used by sort; you don't want to mess with them (see this question for instance)).
Additionally, just for clarity, in your sub find_branch, you can be a bit more compact to retrieve the arguments:
my ($X1, $Y1, $Z1, $X2, $Y2, $Z2) = #_;
I'm fairly convinced that there are other issues with your code. Please tell us what you are trying to do and what each function is supposed to do if you want more help.

Related

Perl - Implementing Perl Script with Perl Module

I would imagine this is too big and too specific for a normal StackOverflow question, so I can understand if there isn't any possible help. However I will try and show what is the issue I am facing. Also I am new to Perl and I know you shouldn't declare all variables at the start, I'm just trying to see if I can get this implemented first.
I have a Perl script:
use 5.010;
use Math::Trig ':radial';
use Math::Trig;
use List::Util qw(max min);
#Input parameters:
#The ouput filename:
$outfile = 'Tree.scad';
#The coordinates of the points that is to be supported.
$min_X=0;
$max_X=60;
$min_Y=0;
$max_Y=60;
$distance=10;
#The minimum angle from horizontal your printer can make, in degrees
$min_angle= 40;
#Ignore the next line, it is not an input parameter.
($X_ref,$Y_ref)=grid($min_X,$max_X,$min_Y,$max_Y,$distance);#X=#$X_ref;#Y=#{$Y_ref};
for $i (0..$#X){
$Z[$i]=20;#The function that defined the height of each point. This setting wil give you a flat roof. For a more advanced tree, try:
#$Z[$i]=-0.01*$X[$i]**2+0.2*$Y[$i]-0.005*$Y[$i]**2+20;
}
#End of input parameters.
$min_radian = deg2rad($min_angle);
$b = tan($min_radian);
#Z=map{$_/$b}#Z;
open $output, '>', $outfile or die "error writing to '$outfile'";
print $output "width=2;\n";
print $output "sphere_radius=0;\n";
print $output "base_plate_size=10;\n\n";
while ($#X>0){
($I,$J)=find_min_dist(\#X,\#Y,\#Z);
($X_branch,$Y_branch,$Z_branch)=find_branch($X[$I],$Y[$I],$Z[$I],$X[$J],$Y[$J],$Z[$J]);
#X_list=($X_branch,$X[$I],$X[$J]);
#Y_list=($Y_branch,$Y[$I],$Y[$J]);
#Z_list=($Z_branch,$Z[$I],$Z[$J]);
for $j (0..$#Y_list){
if (abs($X_list[$j]) < 0.001){
$X_list[$j]=0;
}
if (abs($Y_list[$j]) < 0.001){
$Y_list[$j]=0;
}
if (abs($Z_list[$j]) < 0.001){
$Z_list[$J]=0;
}
}
branch(\#X_list,\#Y_list,\#Z_list);
splice(#X,$I,1,$X_branch);
splice(#X,$J,1);
splice(#Y,$I,1,$Y_branch);
splice(#Y,$J,1);
splice(#Z,$I,1,$Z_branch);
splice(#Z,$J,1);
}
print $output 'if(base_plate_size>0){';
print $output "\n translate([$X[0],$Y[0],$Z[0]*$b])\n";
print $output "cube([base_plate_size,base_plate_size,1],center=true);}";
sub grid{
my $d=$_[4];
#X_values=$_[0]/$d..$_[1]/$d;
#X_values=map{$_*$d} #X_values;
#Y_values=$_[2]/$d..$_[3]/$d;
#Y_values=map{$_*$d} #Y_values;
for $i (0..$#X_values){
#Y=(#Y,#Y_values);
for $j (0..$#Y_values){
$X[$i*($#Y_values+1)+$j]= $X_values[$i];
}
}
return (\#X,\#Y);
}
sub branch{
my #X=#{ $_[0] };
my #Y=#{ $_[1] };
my #Z=#{ $_[2] };
#Z=map{$_*$b}#Z;
for $i (1..$#X){
($rho, $theta, $phi) = cartesian_to_spherical($X[$i]-$X[0],$Y[$i]-$Y[0],$Z[$i]-$Z[0]);
$phi = rad2deg($phi);
if (abs($phi)<0.001){$phi=0;}
$theta = rad2deg($theta)+90;
if (abs($theta)<0.001){$theta=0;}
if (abs($rho)>0.001){
print $output "translate([$X[0],$Y[0],$Z[0]])\n";
print $output "rotate([0,0,$theta])\n";
print $output "rotate([$phi,0,0])\n";
print $output "translate([-width/2,-width/2,0])";
print $output "cube([width,width,$rho]);\n";
print $output 'if (sphere_radius>0){';
print $output "\n translate([$X[$i],$Y[$i],$Z[$i]])\n";
print $output "sphere(sphere_radius,center=1);}\n";}
}
}
sub find_min_dist{
my #X=#{ $_[0] };
my #Y=#{ $_[1] };
my #Z=#{ $_[2] };
my $min_dist=($X[0]-$X[1])**2+($Y[0]-$Y[1])**2+($Z[0]-$Z[1])**2;
my $max_Z=$Z[0];
my $I=0;
my $J=1;
for $i (1..$#Z){
if ($Z[$i]>=$max_Z){
$max_Z=$Z[$i];
$I=$i;}
}
for $j (0..$#X){
if ($j!=$I){
$dist=(($X[$I]-$X[$j])**2+($Y[$I]-$Y[$j])**2+($Z[$I]-$Z[$j])**2);
if ($min_dist>$dist){
$min_dist=$dist;
$J=$j;
}}}
return ($I,$J);
}
sub find_branch{
my $X1=$_[0];
my $Y1=$_[1];
my $Z1=$_[2];
my $X2=$_[3];
my $Y2=$_[4];
my $Z2=$_[5];
$rXY=sqrt(($X1-$X2)**2+($Y1-$Y2)**2);
if (abs($Z1-$Z2) < $rXY) {
$Z_branch=($Z1+$Z2-$rXY)/2;
$a=($Z1-$Z_branch)/$rXY;
$X_branch=(1-$a)*$X1+$a*$X2;
$Y_branch=(1-$a)*$Y1+$a*$Y2;
}
elsif ($Z1 < $Z2) {
$X_branch=$X1;
$Y_branch=$Y1;
$Z_branch=$Z1;
}
else {
$X_branch=$X2;
$Y_branch=$Y2;
$Z_branch=$Z2;
}
return ($X_branch,$Y_branch,$Z_branch);
}
Which produces a scad file and outputs it as this:
I thought it would be good to implement this method in a slicing program, Slic3r. Now what I have done is attempted to still keep it separate since I would like to show at least this structure in the program and decide whether or not it is possible to do.
Slic3r Original Code: https://github.com/slic3r/Slic3r/blob/21eb603cc16946b14e77d3c10cbee2f1163503c6/lib/Slic3r/Print/SupportMaterial.pm
Modified Slic3r Code: https://pastebin.com/aHzXT4RW
So the comparison is, I removed the generate_pillar_supports and added my grid subroutine. I assumed I would just have to call it since this script is separate to how it's generated compared to the other support structures on:
So replaced this:
my $shape = [];
if ($self->object_config->support_material_pattern eq 'pillars') {
$self->generate_pillars_shape($contact, $support_z, $shape);
}
With this:
my $shape = [];
if ($self->object_config->support_material_pattern eq 'pillars') {
$self->grid($min_X,$max_X,$min_Y,$max_Y,$distance);
}
However unfortunately, I have not been able to get a nice structure to form but rather this:
As I said, I know this is a large question and I'm not diving into the entire Slic3ing program so it might be even harder to understand. However just from a brief look, would anyone know what the issue is? Am I calling the subroutine wrong, does the script only work to produce a scad file, etc. All I would need is just to see if this is able to show or not. Thanks.
sub grid does not appear to be a method, but you are calling it as one
$self->grid($min_X,$max_X,$min_Y,$max_Y,$distance);
This syntax actually sends $self as the first argument, so that call is equivalent to the function call
grid($self,$min_X,$max_X,$min_Y,$max_Y,$distance);
What you probably want is to just say
grid($min_X,$max_X,$min_Y,$max_Y,$distance);
(You also really want to say
use strict;
use warnings;
at the top of every script)

Odd number in anonymous hash

Anyone can explain me why this warning occurs in my program. So far my limited knowledge of perl, this should work properly.
$clone = $cromozom;
print "-- Clone: $clone->{_secventa} | $clone->{_performanta} \n";
mutatie($clone);
print "-- After mutation: $clone->{_secventa} | $clone->{_performanta} \n";
$clone->{_performanta} = performanta{$clone->{_secventa}};
$counter += 1;
And this is the performanta subroutine.
sub performanta{
my $sir = shift;
my $distanta = 0;
my $index;
for($index = 0; $index < length($sir); $index +=1){
$distanta += abs(ord(substr($sir, $index, 1)) - ord(substr($solutieOptima, $index, 1)));
}
return $distanta;
}
It says Odd number of elements in anonymous hash at this line: $clone->{_performanta} = performanta{$clone->{_secventa}};.
Thank you.
You're calling performanta{$clone->{_secventa}}. When perl tries to parse this, it's getting performanta( { $clone->{_secventa} } ) which is:
call the performanta sub
it gets one parameter
that one parameter is an anonymous hash ref, initialised with { ... }
the list that initialises that hash ref is only one item long, $clone->{_secventa}.
It's not entirely clear to me what you intended, but it's entirely clear to perl that whatever you told it isn't going to be what you intended to tell it, thus the helpful warning.

Reference counting problem with Perl 5.12.3?

It seems that it's cleaning up the pad too early:
sub search {
my ( $self, $test ) = #_;
my $where;
my $found = 0;
my $counter = 0;
$self->descend( pre_each => sub {
my $lvl = shift;
my $ev_return
= $lvl->each_value( sub {
$counter++;
my ( $name, $value ) = #_;
say "\$name=$name";
say "\$value=$value";
return 1 unless $found = $test->( $value );
$where = { key => $lvl, name => $name, value => $value };
# when any intermediate function sees QUIT_FLAG, it
# knows to return control to the method that called it.
return QUIT_FLAG;
});
say "\$found=$found";
say "\$where=$where";
return $ev_return;
});
say "\$counter=$counter";
say "\$found=$found";
say "\$where=$where";
return unless $found;
return $where;
}
And what I get is:
...
$found=1
$where=HASH(...)
$counter=0
$found=0
$where=
Or, if anybody can point to something bone-headed I'm doing, I'd really appreciate it. I even created incremental variables between the first and outer closure, but they got reset too. Even setting references on the innermost closure, gets me nothing in the named sub scope!
The entire code concerned here is 500 lines. It is impractical to include the code.
It would be really good if you could provide a complete, runnable example.
Stab in the dark: does it help to have an extraneous use of $found in the outer anonymous sub (e.g. $found if 0;)?
Do not use my with statement modifiers!
The problem turned out to be in a called scope. Having forgotten the warning against using my with a statement modifier, I had coded the following:
my $each = shift if #_ == 1;
my %params = #_ unless $each;
The first time it went through #_ had one argument. It assigned the first value to $each. The second time through, with more arguments it skipped the my. So there was no declaration in the current scope, so it simply reused the sub that I had assigned the last time, and saved nothing in %params because the $each it referred to had a value.
Weird, but as ysth pointed out perlsyn warns against this behavior. I think I used to know this, but have forgotten it over the years. Switching it to
my ( %params, $each );
if ( #_ == 1 ) {
$each = shift;
}
else {
%params = #_;
}
did the trick. It not only cleaned up the problems I was having with another method, but it cleaned up problems in search.

In Perl, how can I call a method whose name I have in a string?

I'm trying to write some abstract code for searching through a list of similar objects for the first one whose attributes match specific values. In order to do this, I need to call a bunch of accessor methods and check all their values one by one. I'd like to use an abstraction like this:
sub verify_attribute {
my ($object, $attribute_method, $wanted_value) = #_;
if ( call_method($object, $attribute_method) ~~ $wanted_value ) {
return 1;
}
else {
return;
}
}
Then I can loop through a hash whose keys are accessor method names and whose values are the values I'm looking for for those attributes. For example, if that hash is called %wanted, I might use code like this to find the object I want:
my $found_object;
FINDOBJ: foreach my $obj (#list_of_objects) {
foreach my $accessor (keys %wanted) {
next FINDOBJ unless verify_attribute($obj, $accessor, $wanted{$accessor});
}
# All attrs verified
$found_object = $obj;
last FINDOBJ;
}
Of course, the only problem is that call_method does not exsit. Or does it? How can I call a method if I have a string containing its name? Or is there a better solution to this whole problem?
my $found_object;
FINDOBJ: foreach my $obj (#list_of_objects) {
foreach my $accessor (keys %wanted) {
next FINDOBJ unless $obj->$accessor() == $wanted{$accessor};
}
# All attrs verified
$found_object = $obj;
last;
}
Yes, you can call methods this way. No string (or any other) eval involved.
Also, substitute == with eq or =~ depending on the type of the data...
Or, for some extra credits, do it the functional way: (all() should really be part of List::Util!)
use List::Util 'first';
sub all (&#) {
my $code = shift;
$code->($_) || return 0 for #_;
return 1;
}
my $match = first {
my $obj = $_;
all { $obj->$_ == $attrs{$_} }
keys %wanted
} #list_of_objects;
Update: Admittedly, the first solution is the less obfuscated one, so it's preferable. But as somebody answering questions, you have add a little sugar to make it interesting for yourself, too! ;-)
Functional way is cool, but for dummies like me eval rules:
test.pl
#!/usr/bin/perl -l
use F;
my $f = F->new();
my $fun = 'lol'; # method of F
eval '$f->'.$fun.'() '; # call method of F, which name is in $fun var
F.pm
package F;
sub new
{
bless {};
}
sub lol
{
print "LoL";
}
1;
[root#ALT-24 root]# perl test.pl
LoL

Perl: if ( element in list )

I'm looking for presence of an element in a list.
In Python there is an in keyword and I would do something like:
if element in list:
doTask
Is there something equivalent in Perl without having to manually iterate through the entire list?
UPDATE:
The smartmatch family of features are now experimental
Smart match, added in v5.10.0 and significantly revised in v5.10.1, has been a regular point of complaint. Although there are a number of ways in which it is useful, it has also proven problematic and confusing for both users and implementors of Perl. There have been a number of proposals on how to best address the problem. It is clear that smartmatch is almost certainly either going to change or go away in the future. Relying on its current behavior is not recommended.
Warnings will now be issued when the parser sees ~~, given, or when.
If you can get away with requiring Perl v5.10, then you can use any of the following examples.
The smart match ~~ operator.
if( $element ~~ #list ){ ... }
if( $element ~~ [ 1, 2, 3 ] ){ ... }
You could also use the given/when construct. Which uses the smart match functionality internally.
given( $element ){
when( #list ){ ... }
}
You can also use a for loop as a "topicalizer" ( meaning it sets $_ ).
for( #elements ){
when( #list ){ ... }
}
One thing that will come out in Perl 5.12 is the ability to use the post-fix version of when. Which makes it even more like if and unless.
given( $element ){
... when #list;
}
If you have to be able to run on older versions of Perl, there still are several options.
You might think you can get away with using List::Util::first, but there are some edge conditions that make it problematic.
In this example it is fairly obvious that we want to successfully match against 0. Unfortunately this code will print failure every time.
use List::Util qw'first';
my $element = 0;
if( first { $element eq $_ } 0..9 ){
print "success\n";
} else {
print "failure\n";
}
You could check the return value of first for defined-ness, but that will fail if we actually want a match against undef to succeed.
You can safely use grep however.
if( grep { $element eq $_ } 0..9 ){ ... }
This is safe because grep gets called in a scalar context. Arrays return the number of elements when called in scalar context. So this will continue to work even if we try to match against undef.
You could use an enclosing for loop. Just make sure you call last, to exit out of the loop on a successful match. Otherwise you might end up running your code more than once.
for( #array ){
if( $element eq $_ ){
...
last;
}
}
You could put the for loop inside the condition of the if statement ...
if(
do{
my $match = 0;
for( #list ){
if( $element eq $_ ){
$match = 1;
last;
}
}
$match; # the return value of the do block
}
){
...
}
... but it might be more clear to put the for loop before the if statement.
my $match = 0;
for( #list ){
if( $_ eq $element ){
$match = 1;
last;
}
}
if( $match ){ ... }
If you're only matching against strings, you could also use a hash. This can speed up your program if #list is large and, you are going to match against %hash several times. Especially if #array doesn't change, because then you only have to load up %hash once.
my %hash = map { $_, 1 } #array;
if( $hash{ $element } ){ ... }
You could also make your own subroutine. This is one of the cases where it is useful to use prototypes.
sub in(&#){
local $_;
my $code = shift;
for( #_ ){ # sets $_
if( $code->() ){
return 1;
}
}
return 0;
}
if( in { $element eq $_ } #list ){ ... }
if( $element ~~ #list ){
do_task
}
~~ is the "smart match operator", and does more than just list membership detection.
grep is helpful here
if (grep { $_ eq $element } #list) {
....
}
If you plan to do this many times, you can trade-off space for lookup time:
#!/usr/bin/perl
use strict; use warnings;
my #array = qw( one ten twenty one );
my %lookup = map { $_ => undef } #array;
for my $element ( qw( one two three ) ) {
if ( exists $lookup{ $element }) {
print "$element\n";
}
}
assuming that the number of times the element appears in #array is not important and the contents of #array are simple scalars.
List::Util::first
$foo = first { ($_ && $_ eq "value" } #list; # first defined value in #list
Or for hand-rolling types:
my $is_in_list = 0;
foreach my $elem (#list) {
if ($elem && $elem eq $value_to_find) {
$is_in_list = 1;
last;
}
}
if ($is_in_list) {
...
A slightly different version MIGHT be somewhat faster on very long lists:
my $is_in_list = 0;
for (my $i = 0; i < scalar(#list); ++$i) {
if ($list[i] && $list[i] eq $value_to_find) {
$is_in_list = 1;
last;
}
}
if ($is_in_list) {
...
TIMTOWTDI
sub is (&#) {
my $test = shift;
$test->() and return 1 for #_;
0
}
sub in (#) {#_}
if( is {$_ eq "a"} in qw(d c b a) ) {
print "Welcome in perl!\n";
}
List::MoreUtils
On perl >= 5.10 the smart match operator is surely the easiest way, as many others have already said.
On older versions of perl, I would instead suggest List::MoreUtils::any.
List::MoreUtils is not a core module (some say it should be) but it's very popular and it's included in major perl distributions.
It has the following advantages:
it returns true/false (as Python's in does) and not the value of the element, as List::Util::first does (which makes it hard to test, as noted above);
unlike grep, it stops at the first element which passes the test (perl's smart match operator short circuits as well);
it works with any perl version (well, >= 5.00503 at least).
Here is an example which works with any searched (scalar) value, including undef:
use List::MoreUtils qw(any);
my $value = 'test'; # or any other scalar
my #array = (1, 2, undef, 'test', 5, 6);
no warnings 'uninitialized';
if ( any { $_ eq $value } #array ) {
print "$value present\n"
}
P.S.
(In production code it's better to narrow the scope of no warnings 'uninitialized').
Probably Perl6::Junction is the clearest way to do. No XS dependencies, no mess and no new perl version required.
use Perl6::Junction qw/ any /;
if (any(#grant) eq 'su') {
...
}
This blog post discusses the best answers to this question.
As a short summary, if you can install CPAN modules then the best solutions are:
if any(#ingredients) eq 'flour';
or
if #ingredients->contains('flour');
However, a more usual idiom is:
if #any { $_ eq 'flour' } #ingredients
which i find less clear.
But please don't use the first() function! It doesn't express the intent of your code at all. Don't use the "Smart match" operator: it is broken. And don't use grep() nor the solution with a hash: they iterate through the whole list. While any() will stop as soon as it finds your value.
Check out the blog post for more details.
PS: i'm answering for people who will have the same question in the future.
You can accomplish a similar enough syntax in Perl if you do some Autoload hacking.
Create a small package to handle the autoload:
package Autoloader;
use strict;
use warnings;
our $AUTOLOAD;
sub AUTOLOAD {
my $self = shift;
my ($method) = (split(/::/, $AUTOLOAD))[-1];
die "Object does not contain method '$method'" if not ref $self->{$method} eq 'CODE';
goto &{$self->{$method}};
}
1;
Then your other package or main script will contain a subroutine that returns the blessed object which gets handled by Autoload when its method attempts to be called.
sub element {
my $elem = shift;
my $sub = {
in => sub {
return if not $_[0];
# you could also implement this as any of the other suggested grep/first/any solutions already posted.
my %hash; #hash{#_} = ();
return (exists $hash{$elem}) ? 1 : ();
}
};
bless($sub, 'Autoloader');
}
This leaves you with usage looking like:
doTask if element('something')->in(#array);
If you reorganize the closure and its arguments, you can switch the syntax around the other way to make it look like this, which is a bit closer to the autobox style:
doTask if search(#array)->contains('something');
function to do that:
sub search {
my #arr = #_;
my $sub = {
contains => sub {
my $elem = shift or return;
my %hash; #hash{#arr} = ();
return (exists $hash{$elem}) ? 1 : ();
}
};
bless($sub, 'Autoloader');
}