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.
I'm learning Perl from Intermediate Perl by Randal Schwartz. Can somebody explain the assignment of the variables $callback and $getter in the following code?
use File::Find;
sub create_find_callbacks_that_sum_the_size {
my $total_size = 0;
return(sub {$total_size += -s if -f}, sub { return $total_size });
}
my %subs;
foreach my $dir (qw(bin lib man)) {
my ($callback, $getter) = create_find_callbacks_that_sum_the_size( );
$subs{$dir}{CALLBACK} = $callback;
$subs{$dir}{GETTER} = $getter;
}
for (keys %subs) {
find($subs{S_}{CALLBACK}, $_);
for (sort keys %subs) {
my $sum = $subs{$_}{GETTER}->( );
print "$_ has $sum bytes\n";
}
Am I right in thinking that $callback gets the value of the first subroutine reference:
sub {$total_size += -s if -f}
And that $getter gets the second subroutine reference:
sub { return $total_size }
Is this a list assignment?
many thanks
This is a list assignment. The subroutine returns two things. The first thing goes into $callback and the second thing goes into $getter:
my ($callback, $getter) = create_find_callbacks_that_sum_the_size( );
So, yes, your answer is right. Each ends up with one of the anonymous subroutines created in the create_find_callbacks_that_sum_the_size factory.
I have the following perl script which is storing some details in a hash. After populating some entries in the hash, I'm printing the content of the hash which produces the following output
Key:4:Name4 Value:Name4
Key:3:Name3 Value:Name3
Key:2:Name2 Value:Name2
Key:1:Name1 Value:Name1
Key:0:Name0 Value:Name0
After that I am trying the get search for a hey which does not exist in the hash (my $nm = $components{'11:Name11'}{'name'} );
After this check If I print the content of hash, I see that above key (i.e '11:Name11') is getting added to hash (highlighted below). Can someone explain this behavior please?
Key:4:Name4 Value:Name4
Key:3:Name3 Value:Name3
**Key:11:Name11 Value:**
Key:2:Name2 Value:Name2
Key:1:Name1 Value:Name1
Key:0:Name0 Value:Name0
my %components ;
for ($i=0;$i<5;$i++)
{
my $hash = {} ;
my $vr = $i+100;
$hash->{'container'} = $i ;
$hash->{'name'} = 'Name'.$i;
$hash->{'version'} = $vr ;
my $tmpCompName = $hash->{'container'}.':'.$hash->{'name'};
$components{$tmpCompName} = $hash ;
}
while (my ($k,$v)=each %components){
print "Key:".$k." Value:".$v->{'name'}."\n";
}
my $tmp = '11:Name11';
my $nm = $components{$tmp}{'name'} ;
print "Name:".$nm."\n";
print "After check\n";
while (my ($k,$v)=each %components){
print "Key:".$k." Value:".$v->{'name'}."\n"
}
Thanks in advance.
This is called autovivification. It is a feature of Perl that allows you to use a hash element that you haven't previously declared or initialized. It occurs whenever an undefined value (like $components{'11:Name11'}) is dereferenced (which happens when Perl tries to evaluate $components{'11:Name11'}{'name'}).
There is a autovivification pragma that you can unuse to disable this behavior.
{
no autovivification;
if ($hash{"non-existent-key"}{"foo"}) { # won't create $hash{"non-existent-key"}
...
}
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.
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