I am trying to access elements of arrays by reference, passing references into a sub. Here is my code snippet:
my #arr1 = (1,2);
my #arr2 = (3,4);
my #arr3;
push #arr3, \#arr1;
push #arr3, \#arr2;
for my $i (#arr3) {
print "$i\n";
}
print "Entered Sub func()\n";
for my $i (#arr3) {
func($i);
}
sub func{
my $par = shift;
print $par."\n";
}
print "------------------------\n";
for my $elem(#$par) {
print $elem."\n";
}
And here is the ouput:
C:\Users\ag194y>perl arrs.pl
ARRAY(0x357b28)
ARRAY(0x3575e8)
Entered Sub func()
ARRAY(0x357b28)
ARRAY(0x3575e8)
------------------------
C:\Users\ag194y>
I was expecting to access the elements of #arr1 and a#rr2 with the for loop in the sub, but it looks like array refs are empty. What am I doing wrong? Many thanks.
I think the problem is, loop being outside of func. You are calling func twice, and only after that you are looping through $par, which is undefined at the time.
You might be looking for something like:
sub func{
my $par = shift;
print $par."\n";
print "------------------------\n";
for my $elem (#$par){
print $elem."\n";
}
}
Related
sub process_feed {
my ($line) = #_;
my #lines;
my $last_received = "";
while (1) {
if ($line =~/^{(.*?)}(.*)/) {
push #lines, $1;
$line = $2;
} else {
$last_received = $line;
last;
}
}
print "sending back #lines, $last_received\n";
return (#lines, $last_received);
}
my (#lines, $leftover) = process_feed("{hi1}{hi2}{hi3");
print "got lines: #lines\n";
print "got last_recevied, $leftover\n";
OUTPUT:
sending back hi1 hi2, {hi3
got lines: hi1 hi2 {hi3
got last_recevied,
EXPECTED:
sending back hi1 hi2, {hi3
got lines: hi1 hi2
got last_recevied, {hi3
why did $last_recevied get merged to #lines?
how do i split them in the outer func?
A function returns a flat list. If an array is first in the list of variables being assigned to, the whole list goes into that array. So in
my (#lines, $leftover) = process_feed("{hi1}{hi2}{hi3");
the #lines gets everything that the sub returned.
Solutions
Return a reference to an array along with a scalar, so assign to two scalars
sub process_feed {
# ...
return \#lines, $last_received;
}
my ($rlines, $leftover) = process_feed("{hi1}{hi2}{hi3");
print "got lines: #$rlines\n";
I would recommend this approach, in general.
Since $last_received is always returned, swap the order in the return and assignment
sub process_feed {
# ...
return $last_received, #lines;
}
my ($leftover, #lines) = process_feed("{hi1}{hi2}{hi3");
Since the assignment is to a scalar first only one value from the return is assigned to it and then others go into next variables. Here it is the array #lines, which takes all remaining return.
I am writing a code for calling a subroutine which has 4 argument(3 hashes and one file handler).i want to know how to access them in subroutine.My code is as below.
#print OUTFILE "Content of TPC file:.\n";
my $DATA_INFO = $ARGV[0];
my $OUT_DIR = $ARGV[1];
my $log= "$OUT_DIR/log1";
open(LOG1,">$log");
require "$DATA_INFO";
my $SCRIPT_DIR = $ENV{"SCRIPT_DIR"} ;
require "$SCRIPT_DIR/cmp_fault.pl";
require "$SCRIPT_DIR/pattern_mismatch.pl";
require "$SCRIPT_DIR/scan_count.pl";
print "\nComparing data:\n\n" ;
pattern_mismatch("\%data","\%VAR1","\%status",*LOG1);
cmp_fault("\%data","\%VAR1","\%status",*LOG1);
scan_count("\%data","\%status",*LOG1);
print "\n Comparison done:\n";
foreach $pattern (keys %status) {
print "pattern";
foreach $attr (keys %{$status{$pattern}}) {
print ",$attr";
}
print "\n";
last;
}
#Print Data
foreach $pattern (keys %status) {
print "$pattern";
foreach $attr (keys %{$status{$pattern}}) {
print ",$status{$pattern}{$attr}";
}
print "\n";
Sub routine cmp_fault is here:
sub cmp_fault {
use strict;
use warning;
$data_ref= $_[0];;
$VAR1_ref= $_[1];
$status_ref = $_[2];
$log1_ref=$_[3];
# print LOG1"For TPC : First find the pattern and then its fault type\n";
for $pat ( keys %$data_ref ) {
print "fgh:\n$pat,";
for $key (keys %{$data_ref{$pat}}) {
if($key=~/fault/){
print LOG1 "$key:$data_ref{$pat}{$key},\n";
}
}
}
# print LOG1 "\nFor XLS : First find the pattern and then its pattern type\n";
for $sheet (keys %$VAR1_ref){
if ("$sheet" eq "ATPG") {
for $row (1 .. $#{$VAR1_ref->{$sheet}}) {
$patname = $VAR1_ref->{'ATPG'}[$row]{'Pattern'} ;
next if ("$patname" eq "") ;
$faultXls = $VAR1_ref->{'ATPG'}[$row]{'FaultType'} ;
# print LOG1 " $patname==>$faultXls \n";
if (defined $data{$patname}{'fault'}) {
$faultTpc = $data{$patname}{'fault'} ;
# print LOG1 "\n $patname :XLS: $faultXls :TPC: $faultTpc\n";
if("$faultXls" eq "$faultTpc") {
print LOG1 "PASS: FaultType Matched $patname :XLS: $faultXls :TPC: $faultTpc\n\n\n";
print "PASS: FaultType Matched $patname :XLS: $faultXls :TPC: $faultTpc\n\n";
$status_ref->{$patname}{'FaultType'} = PASS;
}
else {
print LOG1 "FAIL: FaultType Doesn't Match\n\n";
$status_ref->{$patname}{'FaultType'} = Fail;
}
}
}
}
}
}
return 1;
When passing parameters into an array, you can only ever pass a single list of parameters.
For scalars, this isn't a problem. If all you're acting on is a single array, this also isn't a problem.
If you need to send scalars and an array or hash, then the easy way is to 'extract' the scalar parameters first, and then treat 'everything else' as the list.
use strict;
use warnings;
sub scalars_and_array {
my ( $first, $second, #rest ) = #_;
print "$first, $second, ", join( ":", #rest ), "\n";
}
scalars_and_array( "1", "2", "3", 4, 5, 6 );
But it should be noted that by doing so - you're passing values. You can do this with hashes too.
To pass data structure references, it's as you note - pass by reference, then dereference. It's useful to be aware though, that -> becomes useful, because it's accessing a hash and dereferencing it.
use strict;
use warnings;
use Data::Dumper;
sub pass_hash {
my ( $hashref ) = #_;
print $hashref,"\n";
print $hashref -> {"one"},"\n";
print $hashref -> {"fish"} -> {"haddock"};
}
my %test_hash = ( "one" => 2,
"three" => 4,
"fish" => { "haddock" => "plaice" }, );
pass_hash ( \%test_hash );
print "\n";
print Dumper \%test_hash;
The core of your problem here though, is that you haven't turned on strict and warnings which would tell you that:
for $pat ( keys %data_ref ) {
is wrong - there is no hash called data_ref there's only a scalar (which holds a hash reference) called $data_ref.
You need %$data_ref here.
And here:
for $key ( keys %{ $data{$pat} } ) {
You also have no $data - your code says $data_ref. (You might have %data in scope, but that's a really bad idea to mess around with within a sub).
There's a bunch of other errors - which would also be revealed by strict and warnings. That's a very basic debugging step, and you will generally get a much better response from Stack Overflow if you do this before asking for assistance. So please - do that, tidy up your code and remove errors/warnings. If you are still having problems after that, then by all means make a post outlining where and what problem you're having.
I am pulling bitbucket repo list using Perl. The response from bitbucket will contain only 10 repositories and a marker for the next page where there will be another 10 repos and so on ... (they call it paging response)
So, I wrote a recursive subroutine which calls itself if the next page marker is present. This will continue until it reaches the last page.
Here is my code:
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
use LWP::UserAgent;
use JSON;
my #array;
recursive("my_bitbucket_url");
foreach ( #array ) { print $_."\n"; }
sub recursive
{
my $url = $_[0];
### here goes my LWP::UserAgent code which connects to bitbucket and pulls back the response in a JSON as $response->decoded_content
### hence, removing this code for brevity
my $hash = decode_json $response->decoded_content;
#print Dumper ($hash);
foreach my $a ( #{$hash->{values}} )
{
push #array, $a->{links}->{self}->{href};
}
if ( defined $hash->{next})
{
print "Next page Exists \n";
print "Recursing with $hash->{next} \n";
recursive( $hash->{next} );
}
else
{
print "Last page reached. No more recursion \n"
}
}
Now, my code works fine and it lists all the repos.
Question:
I am not sure about the way I have used the variable my #array; above. I have defined it outside the subroutine, However, I am accessing it directly from the subroutine. Somehow, I feel this is not right.
So, how to append to an array using a recursive subroutine in such cases. Does my code obey Perl ethics or is it something really absurd (yet correct because it works) ?
UPDATE
After following suggestions from #ikegami, #Sobrique and #Hynek -Pichi- Vychodil, I have come with below code which uses while loop and avoids recusrsion.
Here is my thought process:
Define an array #array.
Call the subroutine call_url with initial bitbucket URL and save the response in $hash
Check the $hash for the next page marker
If next page marker exists, then push the elements to #array and call call_url with the new marker. This will be done with the while loop.
If the next page marker does NOT exists, then push the elements to #array. Period.
Print #array content.
And here is my code:
my #array;
my $hash = call_url("my_bitbucket_url ");
if (defined $hash->{next})
{
while (defined $hash->{next})
{
foreach my $a ( #{$hash->{values}} )
{
push #array, $a->{links}->{self}->{href};
}
$hash = call_url($hash->{next});
}
}
foreach my $a ( #{$hash->{values}} )
{
push #array, $a->{links}->{self}->{href};
}
foreach (#array) { print $_."\n"; }
sub call_url
{
### here goes my LWP::UserAgent code which connects to bitbucket and pulls back the response in a JSON as $response->decoded_content
### hence, removing this code for brevity
my $hash = decode_json $response->decoded_content;
#print Dumper ($hash);
return $hash;
}
Would definitely like to hear whether this looks OK or is there still a room for improvement.
Using global variables to return values demonstrates high coupling, something to be avoided.
You're asking if the following is acceptable:
my $sum;
sum(4, 5);
print("$sum\n");
sub sum {
my ($x, $y) = #_;
$sum = $x + $y;
}
The fact that the sub is recursive is completely irrelevant; it just makes your example larger.
Problem fixed:
sub recursive
{
my $url = $_[0];
my #array;
my $hash = ...;
foreach my $a ( #{$hash->{values}} )
{
push #array, $a->{links}->{self}->{href};
}
if ( defined $hash->{next})
{
print "Next page Exists \n";
print "Recursing with $hash->{next} \n";
push #array, recursive( $hash->{next} );
}
else
{
print "Last page reached. No more recursion \n"
}
return #array;
}
{
my #array = recursive("my_bitbucket_url");
foreach ( #array ) { print $_."\n"; }
}
Recursion removed:
sub recursive
{
my $url = $_[0];
my #array;
while (defined($url)) {
my $hash = ...;
foreach my $a ( #{$hash->{values}} )
{
push #array, $a->{links}->{self}->{href};
}
$url = $hash->{next};
if ( defined $url)
{
print "Next page Exists \n";
print "Recursing with $url\n";
}
else
{
print "Last page reached. No more recursion \n"
}
}
return #array;
}
{
my #array = recursive("my_bitbucket_url");
foreach ( #array ) { print $_."\n"; }
}
Clean up of the latest code you posted:
my $url = "my_bitbucket_url";
my #array;
while ($url) {
my $hash = call_url($url);
for my $value ( #{ $hash->{values} } ) {
push #array, $value->{links}{self}{href};
}
$url = $hash->{next};
}
print("$_\n") for #array;
Yes, using a global variable is bad habit even it is lexical scoped variable.
Each recursive code can be rewritten into its imperative loop version and vice versa. It is because all of this is implemented on CPU which doesn't know anything about recursion at all. Thre are only jumps. All calls and returns are just jumps with some stack manipulation so you can rewrite your recursion algorithm into loop. If it is not obvious and simple as in this case you can even emulate stack and behaviour as it is done in your favourite language interpreter or compiler. In this case it's very simple:
my #array = with_loop("my_bitbucket_url");
foreach ( #array ) { print $_."\n"; }
sub with_loop
{
my $url = $_[0];
my #array;
while(1)
{
### here goes my LWP::UserAgent code which connects to bitbucket and
### pulls back the response in a JSON as $response->decoded_content
### hence, removing this code for brevity
my $hash = decode_json $response->decoded_content;
#print Dumper ($hash);
foreach my $a ( #{$hash->{values}} )
{
push #array, $a->{links}->{self}->{href};
}
unless ( defined $hash->{next})
{
print "Last page reached. No more recursion \n";
last
};
print "Next page Exists \n";
print "Recursing with $hash->{next} \n";
$url = $hash->{next};
};
return #array;
}
But when you would like to stick with recursion you can but it is a little bit more tricky. First of all, there is not tail call optimization so you don't have to try write tail call code as your original version does. So you can do this:
my #array = recursion("my_bitbucket_url");
foreach ( #array ) { print $_."\n"; }
sub recursion
{
my $url = $_[0];
### here goes my LWP::UserAgent code which connects to bitbucket and
### pulls back the response in a JSON as $response->decoded_content
### hence, removing this code for brevity
my $hash = decode_json $response->decoded_content;
#print Dumper ($hash);
# this map version is same as foreach with push but more perlish
my #array = map $_->{links}->{self}->{href}, #{$hash->{values}};
if (defined $hash->{next})
{
print "Next page Exists \n";
print "Recursing with $hash->{next} \n";
push #array, recursive( $hash->{next} );
}
else
{
print "Last page reached. No more recursion \n"
}
return #array;
}
But this version is not very efficient so there is way how to write tail call recursive version in perl which is a little bit tricky.
my #array = tail_recursive("my_bitbucket_url");
foreach ( #array ) { print $_."\n"; }
sub tail_recursive
{
my $url = $_[0];
my #array;
return tail_recursive_inner($url, \#array);
# url is mutable parameter
}
sub tail_recursive_inner
{
my $url = $_[0];
my $array = $_[1];
# $array is reference to accumulator #array
# from tail_recursive function
### here goes my LWP::UserAgent code which connects to bitbucket and
### pulls back the response in a JSON as $response->decoded_content
### hence, removing this code for brevity
my $hash = decode_json $response->decoded_content;
#print Dumper ($hash);
foreach my $a ( #{$hash->{values}} )
{
push #$array, $a->{links}->{self}->{href};
}
if (defined $hash->{next})
{
print "Next page Exists \n";
print "Recursing with $hash->{next} \n";
# first parameter is mutable so its OK to assign
$_[0] = $hash->{next};
goto &tail_recursive_inner;
}
else
{
print "Last page reached. No more recursion \n"
}
return #$array;
}
And if you are interested in some real perl trickery
print $_."\n" for tricky_tail_recursion("my_bitbucket_url");
sub tricky_tail_recursion {
my $url = shift;
### here goes my LWP::UserAgent code which connects to bitbucket and
### pulls back the response in a JSON as $response->decoded_content
### hence, removing this code for brevity
my $hash = decode_json $response->decoded_content;
#print Dumper ($hash);
push #_, $_->{links}->{self}->{href} for #{$hash->{values}};
if (defined $hash->{next}) {
print "Next page Exists \n";
print "Recursing with $hash->{next} \n";
unshift #_, $hash->{next};
goto &tricky_tail_recursion;
} else {
print "Last page reached. No more recursion \n"
};
return #_;
}
See also: LWP::UserAgent docs.
A variable defined outside any closures is available to the whole program. It works fine, there's nothing to worry about. Some might call it 'bad style' in certain cases (mostly around program length and action at distance) but that's not a hard constraint.
I'm not sure I necessarily see the advantage of recursion here though - your problem doesn't seem to warrant it. That's not a problem per-se, but it can be a little confusing for future maintenance programmers ;).
I'd be thinking something along the lines of (non recursive):
my $url = "my_bitbucket_url";
while ( defined $url ) {
##LWP Stuff;
my $hash = decode_json $response->decoded_content;
foreach my $element ( #{ $hash->{values} } ) {
print join( "\n", #{ $element->{links}->{self}->{href} } ), "\n";
}
$url = $hash->{next}; #undef if it doesn't exist, so loop breaks.
}
I have an issue passing an array and a variable to a function. For example, I have the following.
my #the_array = ("hello", "hey");
CallFunction(#the_array, "random")
sub CallFunction{
my (#array_ref, $ran_variable) = #_;
foreach $element (#array_ref){
print $element ."\n";
}
}
I would want the following output
hello
hey
But I get the other variable in the output, and I don't know why.
hello
hey
random
The following assignment will put all the values in parameter list #_ into #array_ref:
my (#array_ref, $ran_variable) = #_;
You have two options.
Reorder the passing of parameters, so that the array is at the end:
my #the_array = ( "hello", "hey" );
CallFunction( "random", #the_array );
sub CallFunction {
my ( $ran_variable, #array ) = #_;
for my $element (#array) {
print $element . "\n";
}
}
Or pass the array by reference:
my #the_array = ( "hello", "hey" );
CallFunction( \#the_array, "random" );
sub CallFunction {
my ( $arrayref, $ran_variable ) = #_;
for my $element (#$arrayref) {
print $element . "\n";
}
}
Minor Note — Naming a normal array #array_ref is a little confusing. Save the ref suffix for variables actually holding references.
In a Perl object, I'm trying to add a new field into $self from within a File::Find wanted() sub.
use File::Find;
sub _searchForXMLDocument {
my ($self) = #_;
if($_ =~ /[.]+\.xml/) {
$self->{_xmlDocumentPath} = $_;
}
}
sub runIt{
my ($self) = #_;
find (\&_searchForXMLDocument, $self->{_path});
print $self->{_xmlDocumentPath};
}
_searchForXMLDocument() searches for an XML Document within $self->{_path} and is supposed to append that XML path to $self->{_xmlDocumentPath} but when I try to print it, it remains uninitialized. How do I add the field in $self?
Use of uninitialized value in print at /home/scott/workspace/CCGet/XMLProcessor.pm line 51.
You aren't calling _searchForXMLDocument() in an OO manner, so your $self object isn't being passed to it. This should do the trick now. Use a closure for your method and you have access to $self;
sub runIt{
my ($self) = #_;
my $closure = sub {
if($_ !~ m/[.]+\.xml/) {
$self->{_xmlDocumentPath} = $_;
}
};
find(\&$closure, $self->{_path});
print $self->{_xmlDocumentPath};
}
The first argument to find() needs to carry two pieces of information: the test condition, and the object you're working with. The way to do this is with a closure. The sub { ... } creates a code ref, like you get from \&_searchForXMLDocument, but the closure has access to lexical variables in the enclosing scope, so the current object ($self) is associated with the closure.
sub _searchForXMLDocument {
my ($self) = #_;
if($_ =~ /[.]+\.xml/) {
$self->{_xmlDocumentPath} = $_;
}
}
sub runIt{
my ($self) = #_;
find (sub { $self->_searchForXMLDocument (#_) }, $self->{_path});
print $self->{_xmlDocumentPath};
}
I think you're looking for something like this:
package XMLDocThing;
use strict;
use warnings;
use English qw<$EVAL_ERROR>;
use File::Find qw<find>;
...
use constant MY_BREAK = do { \my $v = 133; };
sub find_XML_document {
my $self = shift;
eval {
find( sub {
return unless m/[.]+\.xml/;
$self->{_xmlDocumentPath} = $_;
die MY_BREAK;
}
, $self->{_path}
);
};
if ( my $error = $EVAL_ERROR ) {
die Carp::longmess( $EVAL_ERROR ) unless $error == MY_BREAK;
}
}
...
# meanwhile, in some other package...
$xmldocthing->find_XML_document;
You pass a closure to find and it can access $self from the containing scope. File::Find::find has no capacity to pass in baggage like objects.