Need help with a perl program - arrays

Ok, so I am trying take a hash and if any string in an array contains the key(not value actual key name) in the hash discard it. Else print out the string. This issue is with a portion of the findHidden sub routine. I have tried a lot of different things, I will comment below where I have issues. I'm sure someone has an answer, always get one on stack overflow :)
#!/usr/bin/perl
# Configure
use strict;
use warnings;
use Data::Dumper;
#
sub findHidden;
sub GetInfo;
sub defineHash;
##############
$passwd = '/etc/passwd';
%info = ();
sub GetInfo {
die "Cannot open: $passwd"
unless (open(PW,$passwd));
while(<PW>) {
chomp;
my ($uname,$junk1,$junk2,$junk3,$domain,$home) = split(':', $_);
next unless ($home =~ /vs/);
%info = (
domain => $domain,
home => "$home/",
tmp => "$home/tmp",
htdocs => "$home/www/htdocs",
cgibin => "$home/www/cgi\-bin",
);
print "\n" . $info{domain} . "\n";
print "+"x40,"\n\n";
findHidden($info{tmp});
}
}
sub findHidden {
defineHash;
print "Searching " . $_[0] . "\n";
print "-"x30,"\n\n";
#hidden = `find $_[0] -iname ".*"`;
for(#hidden) {
foreach $key (keys % hExcludes) {
if ($_ =~ /$key/){ #
last; # This portion is
}else{ # Only an issue when using more
print "$_"; # than 2 keys in my hash.
last;
}
}
}
}
sub defineHash {
%hExcludes = ();
%hExcludes = map { $_, 1 } (
'spamd','.nfs' # If I add another key here, it breaks.
);
%knownExploits =
( );
print Dumper \%hExcludes;
}
GetInfo;
This Works, and prints out something like this:
/somedir/tmp/.testthis
/somedir/tmp/.sdkfbsdif
/somedir/tmp/.asdasdasd
I understand why It is not working, because it is looping through the keys where some are false and some are positive, I just cannot think of how to make it do what I want, please assume I might want to you 10 keys. I know there are ways to do it without using hash key values for my excludes but it is what I want to accomplish.
I have also tried shift #hidden as below to no avail.
foreach $key (keys % hExcludes) {
if ($_ =~ /$key/){ #
last; #
shift #hidden;# This portion is
}else{ # Only an issue when using more
print "$_"; # than 2 keys in my hash.
last;
}
Also, keep in mind that things only stop working when I add the third...or more keys.
%hExcludes = map { $_, 1 } (
'spamd','.nfs','key3' # If I add another key here, it breaks
);

What you need is this:
#hidden = `find $_[0] -iname ".*"`;
for(#hidden) {
undef $isExcluded;
foreach $key (keys % hExcludes) {
if ($_ =~ /$key/){
$isExcluded=1;
last;
}
}
if( ! $isExcluded ) {
print "$_";
}
}
Whatever happened in your scan through the keys of hExcludes, the code encountered a last on the first key and did not process any more. You need to set a flag and continue iterating until either there are no more keys to set, or a match is found. Then you can print out the values that were not matched.

Related

Perl array loop

I have an array in which I want to check if the element in the following check returns a certain value, remove it from the array if matches condition. Continue looping trough array, until all elements are gone.
foreach $temp (#inputs);
{
my $check = &checkStatus($temp, $server);
if ($check ne "Z");
print "$temp failed!\n";
}
It would be best if you had a way to wait for the status of any of the items to change.
For example, if you were dealing with processes, you could use.
my %children = map { $_ => 1 } #pids;
while (%children) {
my $pid = wait();
my $status = $?;
delete($children{$pid});
if ( $status & 0x7F ) { warn("Child $pid killed by signal ".( $status & 0x7F )."\n"); }
elsif ( $status >> 8 ) { warn("Child $pid exited with error ".( $status >> 8 )."\n"); }
else { print("Child $pid exited successfully\n"); }
}
Otherwise, you will need to poll.
use Time::HiRes qw( sleep ); # Time::HiRes::sleep supports fractional durations.
my %foos = map { $_ => 1 } #foo_ids;
while (%foos) {
for my $foo_id (keys(%foos)) {
if (checkStatus($foo_id, $server) eq 'Z') {
delete($foos{$foo_id});
# ...?
}
}
sleep(0.1); # To avoid using 100% CPU.
}
Note that in both cases, you can use the value of the hash elements to contain information about the thing.
# When creating the foos.
$foos{$foo_id} = $foo;
# When waiting the foos.
my $foo = delete($foos{$foo_id});
You can use grep, as suggested by #Shawn:
#inputs_wo_z = grep { checkStatus($_, $server) ne "Z" } #inputs;
Here, grep evaluates the last expression supplied to it, which is whether checkStatus(...) returns non-Z. By default, each element of the #inputs array is assigned to $_ inside. grep returns all elements of the array for which the condition is true.
Note that it is not necessary to use & before the method call here, because you are using parenthesis. See perlsub for details, and also explained by #ikegami here.
Oleg, the description of the problem is not very clear.
Your code does not delete anything from array. I assume that you want to iterate through array and only print data when element meets some condition.
Please see the following example where I imitate in an array storing temperature reported by farm of servers
#!/usr/bin/perl -CS
#
# vim: ai:ts=4:sw=4
#
use strict;
use warnings;
use feature 'say';
my $max_temp = 36; # maximum permited termperature
my #data = <DATA>; # fill array with some data
for (#data) {
next if /^\s*$/; # skip empty lines
chomp;
my($s,$t) = split ',';
say chr(0x267F) . " $s temp=$t" if $t > $max_temp;
}
__DATA__
server1,32
server2,30
server3,42
server4,32
server5,37
server6,36
server7,30
Output
♿ server3 temp=42
♿ server5 temp=37

Perl array - trying to parse quotes in proper array elements

I have been struggling with this for a while in a Perl script I have. Probably a slam dunk for you Perl experts, and probably should be easier, but I can't quite crack the nut on this. I might be needing to split this, not sure.
My array code as is follows.
while ( my $row = $query_handle->fetchrow_hashref('NAME_lc') ){
push #query_output, $row;
push (#{portfo->{label}},$row->{data},$row->{label});
}
And then my print of the array is as follows:
print "array here--";
print "[";
foreach (#{portfo->{label}}) {
#(#{portfo->{label}},$row->{data});
print "\{\"data\":";
print "".$_.",";
print "\"label\":";
print "\"".$row[1]."\"\},";
}
print "]";
print "\n";
And then my output looks like this:
[{"data":2943,"label":""},{"data":CDI3,"label":""},
{"data":1,"label":""},{"data":COS-COS2,"label":""},
{"data":1087,"label":""},{"data":COS1,"label":""},
{"data":5183,"label":""},{"data":COS2,"label":""},
{"data":2731,"label":""},{"data":CULB,"label":""},{"data":1,"label":""},
{"data":EQUIT,"label":""},{"data":4474,"label":""},
{"data":Network,"label":""},]
I am trying to make the apha-num string array items like CDI3, COS1, COS2, etc in quotes, in the label part. Somehow I'm getting it separated. Meanwhile, I do want the numeric values left with the "data" name pair.
[{"data":2943,"label":""},{"data":"CDI3","label":""},
{"data":1,"label":""},{"data":"COS-COS2","label":""},
{"data":1087,"label":""},{"data":"COS1","label":""},
{"data":5183,"label":""},{"data":"COS2","label":""},
{"data":2731,"label":""},{"data":"CULB","label":""},{"data":1,"label":""},
{"data":"EQUIT","label":""},{"data":4474,"label":""},
{"data":"Network","label":""}]
I'm sure it's a simpler fix that I'm making it but so far no luck. Any tips would be greatly appreciated!
Thanks!
use JSON::XS qw( encode_json );
my #data;
while ( my $row = $query_handle->fetchrow_hashref('NAME_lc') ) {
# If $row->{data} is a number,
# make sure it's stored as a number
# so that it gets serialized as a number.
$row->{data} += 0 if $row->{data} =~ /^\d+\z/;
push #data, $row;
}
print(encode_json(\#data));
Or
my $data = $query_handle->fetchall_arrayref({ data => 1, label => 1 });
for my $row (#$data) {
$row->{data} += 0 if $row->{data} =~ /^\d+\z/;
}
print(encode_json($data));
Or if you ensure the fields names are returned as lowercase[1],
my $data = $query_handle->fetchall_arrayref({});
for my $row (#$data) {
$row->{data} += 0 if $row->{data} =~ /^\d+\z/;
}
print(encode_json($data));
This can be done using $dbh->{FetchHashKeyName} = 'NAME_lc'; or AS `label`.

Access the key value from an associative array

I have the associative array %cart_item, within this is a series of associative arrays. I need to access the value of the keys within %cart_item. I have the following code which iterates on each array key. (I do the equivalent of php's continue if the value is 'meta')
my $key_value;
for (keys %cart_item) {
next if (/^meta$/ || /^\s*$/);
}
I need to do something like this though (although this isn't valid), setting the value of the keys in the loop:
my $key_value;
for $i (keys %cart_item) {
next if (/^meta$/ || /^\s*$/);
$key_value = $i;
# do stuff
}
Could anyone suggest a solution here? Apologies if this is obvious, I'm a Perl newbie. Thanks
I think you are asking for
for my $key (keys %cart_item) {
next if $key =~ /^meta$/ || $key =~ /^\s*$/;
my $val = $cart_item{$key};
...
}
If you're just looking for the value that goes with the key, you can get both at the same time with each:
while (my ($key, $val) = each %cart_item) {
next if $key eq 'meta' || $key =~ /^\s*$/;
...
}
That's the equivalent of PHP's foreach ($cart_item as $key => $val).
I also changed the "meta" check to use simple string equality; no need to use a regular expression for an exact match.
Your original code has
for ( keys %cart_item ) {
next if (/^meta$/ || /^\s*$/);
}
which works fine because the for has no loop control variable so it defaults to Perl's "pronoun" it variable $_. In addition, your regex pattern matches have no object so they also default to $_
Written fully, this would be
for $_ ( keys %cart_item ) {
next if ( $_ =~ /^meta$/ || $+ =~ /^\s*$/);
}
but we don't have to write all of that. Some people hate it; others like me think it's absolute genius
Your non-working code
my $key_value;
for $i (keys %cart_item) {
next if (/^meta$/ || /^\s*$/);
$key_value = $i;
# do stuff
}
does use a loop control control variable $i (bad name for a hash key, by the way). That's all fine except that your regex matches still
my $key_value;
for $i (keys %cart_item) {
next if $i =~ /^meta$/ or $i =~ /^\s*$/;
$key_value = $i;
# do stuff
}
or, better still, stick with $_ and write this
for ( keys %cart_item ) {
next if /^meta$/ or /^\s*$/;
my $key_value = $_;
# do stuff
}

Perl : matching the contents of a file with the contents of an array

I have an array #arr1 where each element is of the form #define A B.
I have another file, f1 with contents:
#define,x,y
#define,p,q
and so on. I need to check if the second value of every line (y, q etc) matches the first value in any element of the array. Example: say the array has an element #define abc 123 and the file has a line #define,hij,abc.
When such a match occurs, I need to add the line #define hij 123 to the array.
while(<$fhDef>) #Reading the file
{
chomp;
$_ =~ tr/\r//d;
if(/#define,(\w+),(\w+)/)
{
my $newLabel = $1;
my $oldLabel = $2;
push #oldLabels, $oldLabel;
push #newLabels, $newLabel;
}
}
foreach my $x(#tempX) #Reading the array
{
chomp $x;
if($x =~ /#define\h{1}\w+\h*0x(\w+)\h*/)
{
my $addr = $1;
unless(grep { $x =~ /$_/ } #oldLabels)
{
next;
}
my $index = grep { $oldLabels[$_] eq $_ } 0..$#oldLabels;
my $new1 = $newLabels[$index];
my $headerLabel1 = $headerLabel."X_".$new1;
chomp $headerLabel1;
my $headerLine = "#define ".$headerLabel1."0x".$addr;
push #tempX, $headerLine;
}
}
This just hangs. No doubt I'm missing something right in front of me, but what??
The canonical way is to use a hash. Hash the array, using the first argument as the key. Then walk the file and check for existence of the key in the hash. I used a HoA (hash of arrays) to handle multiple values for each key (see the last two lines).
#! /usr/bin/perl
use warnings;
use strict;
my #arr1 = ( '#define y x',
'#define abc 123',
);
my %hash;
for (#arr1) {
my ($arg1, $arg2) = (split ' ')[1, 2];
push #{ $hash{$arg1} }, $arg2;
}
while (<DATA>) {
chomp;
my ($arg1, $arg2) = (split /,/)[1, 2];
if ($hash{$arg2}) {
print "#define $arg1 $_\n" for #{ $hash{$arg2} };
}
}
__DATA__
#define,x,y
#define,p,q
#define,hij,abc
#define,klm,abc
As the other answer said, it's better to use a hash. Also, keep in mind that you're doing a
foreach my $x(#tempX)
but you're also doing a
push #tempX, $headerLine;
which means that you're modifying the array on which you're iterating. This is not just bad practice, this also means that you're most likely going to have an infinite loop because of it.

How can I loop over an array from the first occurrence of an element with a specific value using perl?

I have an array like ("valueA", "valueB", "valueC", "valueD") etc. I want to loop over the values of the array starting from (for example) the first instance of "valueC". Everything in the array before the first instance of the value "valueC" should be ignored; so in this case only "valueC" and "valueD" would be handled by the loop.
I can just put a conditional inside my loop, but is there a neater way to express the idea using perl?
my $seen;
for ( grep $seen ||= ($_ eq "valueC"), #array ) {
...
}
I think you also need to check if the "valueC" exist inside the array.
Hope this helps.
use strict;
use warnings;
use List::Util qw(first);
my #array = qw(valueA valueB valueC valueD);
my $starting_element = 'valueC';
# make sure that the starting element exist inside the array
# first search for the first occurrence of the $stating_element
# dies if not found
my $starting_index = first { $array[$_] eq $starting_element } 0 .. $#array
or die "element \"$starting_element\" does not exist inside the array";
# your loop
for my $index ($starting_index .. $#array) {
print $array[$index]."\n";
}
my $seen;
for ( #array ) {
$seen++ if /valueC/;
next unless $seen;
...
}
But that $seen is a little ungainly. The flip-flop operator looks tidier IMO:
for ( #array ) {
next unless /^valueC$/ .. /\0/;
# or /^valueC$/ .. '' !~ /^$;
# or $_ eq 'valueC' .. /\0/;
...
}
Or simply (building on ikegami's suggestion):
for ( grep { /^valueC$/ .. /(*FAIL)/ } #array ) { ... }
use List::MoreUtils qw( first_index );
foreach my $item ( #array[ ( first_index { $_ eq 'ValueC' } #array ) .. $#array ] ){
# process $item
}
my $start = 0;
++$start while $start < #array && $array[$start] ne 'valueC';
followed by either
for (#array[$start..$#array]) {
say;
}
or
for my $i ($start..$#array) {
say $array[$i];
}
TIMTOWTDI, but I think that:
foreach my $item (#list) {
next if !$seen && ($item ne 'valueC');
$seen++;
...
}
is both readable, correct and and terse enough. All the /valueC/ solution will process anything after "DooDadvalueCFuBAr", not what the OP asked. And, no you need no flipflop/range operator, and checking for the existence beforehand is really strange, besides requiring a possibly noncore package to perform a rather trivial task.The grep solution is really making my head spin, besides creating and tossing a temp array as a side effect.
If you want to get fancy and avoid ''ifs':
foreach my $item (#list) {
$seen || ($item eq 'valueC') || next;
$seen++;
...
}
Just don't write home about it. :-)

Resources