I have a code that is something like this:
foreach $item (#total_data)
{
setinfo($item);
} # #total_data contains an array of references to hashes (\%hash1 ... \%hashN)
In the subrutine goes something like this:
sub setinfo
{
my ($argument) = #_;
my $i = 0;
#inside original hash $argument{"data"}{"fulldraw"} there is an [array]
#that contains numbers of the form XYYZ and I want to split them into
#the following pairs XY YY YZ but that code works ok#
foreach $item (${$argument{"data"}{"fulldraw"}})
{
my $match;
my $matchedstr;
if ($item =~ /^\d{4}$/)
{
...
}
else
{
print STDERR "DISCARDED: $item\n";
}
}
}
I know I am probably making the mistake in how I am dereferencing it, but couldn't figure it out with all the articles I've read on the internet.
Thanks!
#{ ... } # dereference
Maybe $argument is a hashref; you need to use
foreach $item (#{ $argument->{data}->{fulldraw} })
Just use dereference #{ ... }:
foreach $item (#{ $argument->{data}{fulldraw} })
You can use Data::Dumper to visualize complex structures:
use Data::Dumper;
print Dumper($argument);
Related
Need advice on loop
$Variable contains 11111 22222
foreach ($variable in $value) {
for ([byte]$c = [char]'b'; $c -le [char]'c'; $c++) {
$variable."([char]$c)" } }
I am looking output as 11111b and then 22222c but currently, I am getting 11111b , 11111c and then 22222b and then 22222c.
Kindly advice
I am assuming you mean that $value, not $variable, contains 11111 and 22222, specifically in an array.
Since you want $c to maintain its value between iterations of the foreach loop you need to initialize $c outside of the foreach loop. Therefore, you really don't need (or, rather, should not use) two loops at all.
$value = 11111, 22222;
[Byte] $c = [Char] 'b';
foreach ($variable in $value)
{
"$variable$([Char] $c++)"
}
This gives the output you are seeking:
11111b
22222c
Imagine I have this Perl script
my $name = " foo ";
my $sn = " foosu";
trim($name, \$sn);
print "name: [$name]\n";
print "sn: [$sn]\n";
exit 0;
sub trim{
my $fref_trim = sub{
my ($ref_input) = #_;
${$ref_input} =~ s/^\s+// ;
${$ref_input} =~ s/\s+$// ;
};
foreach my $input (#_){
if (ref($input) eq "SCALAR"){
$fref_trim->($input);
} else {
$fref_trim->(\$input);
}
}
}
Result:
name: [foo]
sn: [foosu]
I would expect $name to be "[ foo ]" when printing the value after calling trim, but the sub is setting $name as I would want it. Why is this working, when it really shouldn't?
I'm not passing $name by reference and the trim sub is not returning anything. I'd expect the trim sub to create a copy of the $name value, process the copy, but then the original $name would still have the leading and trailing white spaces when printed in the main code.
I assume it is because of the alias with #_, but shouldn't the foreach my $input (#_) force the sub to copy the value and only treat the value not the alias?
I know I can simplify this sub and I used it only as an example.
Elements of #_ are aliases to the original variables. What you are observing is the difference between:
sub ltrim {
$_[0] =~ s/^\s+//;
return $_[0];
}
and
sub ltrim {
my ($s) = #_;
$s =~ s/^\s+//;
return $s;
}
Compare your code to:
#!/usr/bin/env perl
my $name = " foo ";
my $sn = " foosu";
trim($name, \$sn);
print "name: [$name]\n";
print "sn: [$sn]\n";
sub trim {
my #args = #_;
my $fref_trim = sub{
my ($ref_input) = #_;
${$ref_input} =~ s/^\s+//;
${$ref_input} =~ s/\s+\z//;
};
for my $input (#args) {
if (ref($input) eq "SCALAR") {
$fref_trim->($input);
}
else {
$fref_trim->(\$input);
}
}
}
Output:
$ ./zz.pl
name: [ foo ]
sn: [foosu]
Note also that the loop variable in for my $input ( #array ) does not create a new copy for each element of the array. See perldoc perlsyn:
The foreach loop iterates over a normal list value and sets the scalar variable VAR to be each element of the list in turn. ...
...
the foreach loop index variable is an implicit alias for each item in the list that you're looping over.
In your case, this would mean that, at each iteration $input is an alias to the corresponding element of #_ which itself is an alias to the variable that was passed in as an argument to the subroutine.
Making a copy of #_ thus prevents the variables in the calling context from being modified. Of course, you could do something like:
sub trim {
my $fref_trim = sub{
my ($ref_input) = #_;
${$ref_input} =~ s/^\s+//;
${$ref_input} =~ s/\s+\z//;
};
for my $input (#_) {
my $input_copy = $input;
if (ref($input_copy) eq "SCALAR") {
$fref_trim->($input_copy);
}
else {
$fref_trim->(\$input_copy);
}
}
}
but I find making a wholesale copy of #_ once to be clearer and more efficient assuming you do not want to be selective.
I assume it is because of the alias with #_, but shouldn't the foreach my $input (#_) force the sub to copy the value and only treat the value not the alias?
You're right that #_ contains aliases. The part that's missing is that foreach also aliases the loop variable to the current list element. Quoting perldoc perlsyn:
If any element of LIST is an lvalue, you can modify it by modifying VAR inside the loop. Conversely, if any element of LIST is NOT an lvalue, any attempt to modify that element will fail. In other words, the foreach loop index variable is an implicit alias for each item in the list that you're looping over.
So ultimately $input is an alias for $_[0], which is an alias for $name, which is why you see the changes appearing in $name.
my $pointer = 0;
foreach (#new1)
{
my $test = $_;
foreach (#chk)
{
my $check = $_;
chomp $check;
delete($new1[$pointer]) if ($test =~ /^$check/i);
}
$pointer++;
}
The if statement never matches the fact that many entries in the #new1 array do contain $check at the start of the array element (88 at least).
I am not sure it is the nested loop that is causing the problem because if i try this it also fails to match:
foreach (#chk)
{
#final = (grep /^$_/, #new1);
}
#final is empty but I know at least 88 entires for $_ are in #new1.
I wrote this code on a machine running Windows ActivePerl 5.14.2 and the top code works. I then (using a copy of #new1) compare the two and remove any duplicates (also works on 5.14.2). I did try to negate the if match but that seemed to wipe out the #new1 array (so that I didn't need to do a hash compare).
When I try to run this code on a Linux RedHat box with Perl 5.8.0 it seems to struggle with the variable matching in the REGEX. If I hard code the REGEX with an example I know is in #new1 the match works and in the first code the entry is deleted (in the second one value is inserted in #final).
The #chk array is a listing file on the web server and the #new1 array is created by opening two log files on the web server and then pushing one into the other.
I had even gone to the trouble of printing out $test and $check in each loop iteration and manually checking to see if any of the the values did match and some of them do.
It has had me baffled for days now and I have had to throw the towel in and ask for help, any ideas?
As tested by user1568538, the solution was to replace
chomp $check;
with
$check =~ s/\r\n//g;
to remove Windows-style line endings from the variable.
Since chomp removes the contents of the input record separator $/ from the end of its argument, you could also change its value:
my $pointer = 0;
foreach (#new1)
{
my $test = $_;
foreach (#chk)
{
local $/="\r\n";
my $check = $_;
chomp $check;
delete($new1[$pointer]) if ($test =~ /^$_/i);
}
$pointer++;
}
However, since $/ also affects other operations (such as reading from a file handle), perhaps it is safest to avoid changing $/ unless you are sure if it is safe. Here I limit the change to the foreach loop where the chomp occurs.
No knowing what your input data looks like, using \Q might help:
if ($test =~ /^\Q$check/i);
See quotemeta.
It is not clear what you are trying to do. However, you may be trying to only get those elements for which there is no match or vice versa. Adapt the code below for your needs
#!/usr/bin/perl
use strict; use warnings;
my #item = qw(...); # your #new?
my #check = qw(...); # your #chk?
my #match;
my #nomatch;
ITEM:
foreach my $item (#item) {
CHECK:
foreach my $check (#check) {
# uncomment this if $check should not be interpreted as a pattern,
# but as literal characters:
# $item = '\Q' . $item;
if ($item =~ /^$check/) {
push #match, $item;
next ITEM; # there was a match, so this $item is burnt
# we don't need to test against other $checks.
}
}
# there was no match, so lets store it:
push #nomatch, $item.
}
print "matched $_\n" for #matched;
print "didn't match $_" for #nomatch;
Your code is somewhat difficult to read. Let me tell you what this
foreach (#chk) {
#final = (grep /^$_/, #new1);
}
does: It is roughly equivalent to
my #final = ();
foreach my $check (#chk) {
#final = grep /^$check/, #new1;
}
which is equivalent to
my #final = ();
foreach my $check (#chk) {
# #final = grep /^$check/, #new1;
#final = ();
foreach (#new) {
if (/^$check/) {
push #final, $_;
last;
}
}
}
So your #final array gets reset, possibly emptied.
I have a two level hash %chainro , each key of $chainro{$ro}{$id}points to an array. The following code is to iterate through the first level of hash, $chainro->{$ro}. I can guess what
does my $file = ${$chainro->{$ro}->$id}}[$i]; aim to perform. However, I do not know why ${$chainro->{$ro}->{$id}}was written this way? In specific, why do we need to add ${ } to wrap the $chainro->${ro}->{$id}
foreach my $id (keys %{$chainro->{$ro}})
{
$size = $#{$chainro->{$ro}->{$id}};
for ($i=0; $i<$size; $i++)
{
my $file = ${$chainro->{$ro}->{$id}}[$i];
}
}
${ EXPR1 }[ EXPR2 ]
is an alternate way of writing
EXPR1->[ EXPR2 ]
so
${ $chainro->{$ro}->{$id} }[$i]
can be written as
$chainro->{$ro}->{$id}->[$i]
or even as
$chainro->{$ro}{$id}[$i]
Cleaned up:
for my $id (keys %{ $chainro->{$ro} }) {
my $files = $chainro->{$ro}{$id};
for my $i (0..$#$files) {
my $file = $files->[$i];
...
}
}
Or if you don't need $i:
for my $id (keys %{ $chainro->{$ro} }) {
my $files = $chainro->{$ro}{$id};
for my $file (#$files) {
...
}
}
It is to dereference a reference to something.
The something is an array here.
The following code generates a list of the average number of clients connected by subnet. Currently I have to pipe it through sort | uniq | grep -v HASH.
Trying to keep it all in Perl, this doesn't work:
foreach $subnet (keys %{keys %{keys %days}}) {
print "$subnet\n";
}
The source is this:
foreach $file (#ARGV) {
open(FH, $file) or warn("Can't open file $file\n");
if ($file =~ /(2009\d{4})/) {
$dt = $+;
}
%hash = {};
while(<FH>) {
#fields = split(/~/);
$subnet = $fields[0];
$client = $fields[2];
$hash{$subnet}{$client}++;
}
close(FH);
$file = "$dt.csv";
open(FH, ">$file") or die("Can't open $file for output");
foreach $subnet (sort keys %hash) {
$tot = keys(%{$hash{$subnet}});
$days{$dt}{$subnet} = $tot;
print FH "$subnet, $tot\n";
push #{$subnet}, $tot;
}
close(FH);
}
foreach $day (sort keys %days) {
foreach $subnet (sort keys %{$days{$day}}) {
$tot = $i = 0;
foreach $amt (#{$subnet}) {
$i++;
$tot += $amt;
}
print "$subnet," . int($tot/$i) . "\n";
}
}
How can I eliminate the need for the sort | uniq process outside of Perl? The last foreach gets me the subnet ids which are the 'anonymous' names for the arrays. It generates these multiple times (one for each day that subnet was used).
but this seemed easier than combining
spreadsheets in excel.
Actually, modules like Spreadsheet::ParseExcel make that really easy, in most cases. You still have to deal with rows as if from CSV or the "A1" type addressing, but you don't have to do the export step. And then you can output with Spreadsheet::WriteExcel!
I've used these modules to read a spreadsheet of a few hundred checks, sort and arrange and mung the contents, and write to a new one for delivery to an accountant.
In this part:
foreach $subnet (sort keys %hash) {
$tot = keys(%{$hash{$subnet}});
$days{$dt}{$subnet} = $tot;
print FH "$subnet,$tot\n";
push #{$subnet}, $tot;
}
$subnet is a string, but you use it in the last statement as an array reference. Since you don't have strictures on, it treats it as a soft reference to a variable with the name the same as the content of $subnet. Which is okay if you really want to, but it's confusing. As for clarifying the last part...
Update I'm guessing this is what you're looking for, where the subnet value is only saved if it hasn't appeared before, even from another day (?):
use List::Util qw(sum); # List::Util was first released with perl 5.007003 (5.7.3, I think)
my %buckets;
foreach my $day (sort keys %days) {
foreach my $subnet (sort keys %{$days{$day}}) {
next if exists $buckets{$subnet}; # only gives you this value once, regardless of what day it came in
my $total = sum #{$subnet}; # no need to reuse a variable
$buckets{$subnet} = int($total/#{$subnet}; # array in scalar context is number of elements
}
}
use Data::Dumper qw(Dumper);
print Dumper \%buckets;
Building on Anonymous's suggestions, I built a hash of the subnet names to access the arrays:
..
push #{$subnet}, $tot;
$subnets{$subnet}++;
}
close(FH);
}
use List::Util qw(sum); # List::Util was first released with perl 5.007003
foreach my $subnet (sort keys %subnets) {
my $total = sum #{$subnet}; # no need to reuse a variable
print "$subnet," . int($total/#{$subnet}) . "\n"; # array in scalar context is number of elements
}
I am not sure if this is the best solution, but I don't have the duplicates any more.