Perl array of hashrefs problems - arrays

I have this in my project:
sub get_src_info($) {
my $package = shift;
my ($key,$value,$tail) =("","","");
my (#APT_INFO,$r);
open APT, "apt-cache showsrc $package|";
while (<APT>){
chomp;
($key,$value,$tail) = split /:/;
if (defined ($key) && defined ($value)) {
$value =~ s/^\s+|\s+$//;
if (defined($tail)) {
$value = "$value:$tail";
}
if ( $key eq "Package" or $key eq "Version" ) {
$r->{$key} = $value;
}
}
if(/^$/) { push #APT_INFO,$r++; }
}
close APT;
return #APT_INFO;
}
I generally use use strict to check for errors.
The code works with no strict "refs"; instruction, but fails to run without it, yielding error:
Can't use string ("163277181") as a HASH ref while "strict refs" in use at a.pl line 61, <APT> line 45.
line 61 is: $r->{$key} = $value;
I prefer to fix my code, rather than silence it, but can't get what's wrong/how to fix this.
Also, what's correct way to advance a reference to point to the next object? Although it works I do not feel like $r++ is correct construction in here.
thanks a lot in advance.

You use the $r variable both as a hash reference $r->{$key}, and a number $r++. References numify to an ID, so you can use them as numbers. However, you cannot use a non-reference scalar as a reference (references are not pointers). To make this clear:
my $reference = { foo => 1 };
my $numified = 0 + $reference; # is now 163277181
say $numified->{foo}; # does not work under strict "refs"
# ${"163277181"}{foo} is equivalent: This looks for global variable %163277181
You can work around the problems by simply creating a new reference in $r when a new block begins. You should also scope your other variables properly: do not use globals like APT, and declare your $key etc. variables inside the loop.
Also, $key can never be undef (split doesn't return undef values), and you should not use prototypes.
I guess the following code will do what you want:
use autodie; # automatic error handling, e.g. for `open`
sub get_src_info {
my ($package) = #_;
my $info = {};
my #apt_info;
open my $fh, "-|", "apt", "showsrc", $package; # circumvent the shell for safety
while (<$fh>) {
chomp;
unless (length) {
push #apt_info, $info;
$info = {}; # put a new reference into $info
next;
}
my ($key, $value) = split /:/, $_, 2; # limit number of fragments to 2
next unless $key eq "Package" or $key eq "Version";
s/^\s+//, s/\s+$// for $value; # this trims at *both* ends
$info->{$key} = $value;
}
return #apt_info;
}
More on References vs. Pointers:
You cannot use pointer arithmetic in memory safe languages. Perl is such a memory safe language. The references which you can use are similar to pointers in C. They are typed as well (although dynamically), but are reference counted automatically, so that the referenced data structure is freed once it isn't needed. Proponents of garbage collection and memory safety point to less errors (e.g. double free) and increased productivity, although some algorithms may not be expressed as elegantly. Most modern languages are memory safe by default.
Even if this were C, and $r++ would point to a new address, I'd have to ask you: Shouldn't you malloc new memory? Memory allocation is implicit in Perl. The $r = {} gives us a new, empty hash reference. If you use lexical variables (with my), deallocation happens automatically as well.

Related

How to loop through file and count specific values in perl?

Let's say I have a file with the lines such as:
*some numbers* :00: *somenumbers*
*somenumbers* :21: *somenumbers*
And for every number between :: I need to count how many times it repeats in the file?
while (<>){
chomp($_);
my ($nebitno,$bitno,$opetnebitno) = split /:/, $_;
$count{$bitno}++;
}
foreach $bitno(sort keys %count){
print $bitno," ",$count{bitno}, "\n";
}
What you produced was not bad code — it did the job for a single file at a time. Adapting the code shown in the question to handle multiple files, resetting the counts after each file:
#!/usr/bin/perl
use strict;
use warnings;
my %count = ();
while (<>) {
my ($nebitno, $bitno, $opetnebitno) = split /:/, $_;
$count{$bitno}++;
}
continue
{
if (eof) {
print "$ARGV:\n";
foreach $bitno (sort keys %count) {
print "$bitno $count{bitno}\n";
}
%count = ();
}
}
The key here is the continue block, and the if (eof) test. You can use close $ARGV in a continue block to reset $. (the line number) when the file changes; it is a common use for it. This sort of per-file summary is another use. The other changes are cosmetic. You don't need to chomp the line (though there's no particular harm done if you do); I print whole strings rather than using comma-separated lists (it works well here and very often). I use a few more spaces. I left it with the 1TBS format for the blocks of code, though I don't use that myself (I use Allman).
My draft solution used practically the same printing code as shown above, but the main while loop was slightly different:
#!/usr/bin/env perl
use strict;
use warnings;
my %counts = ();
while (<>)
{
$counts{$1}++ if (m/.*:(\d+):/);
}
continue
{
if (eof)
{
print "$ARGV:\n";
foreach my $number (sort { $a <=> $b } keys %counts)
{
print ":$number: $counts{$number}\n"
}
%counts = ();
}
}
The only advantage over what you used is that if some line doesn't contain a colon-surrounded number, it ignores the line, whereas yours doesn't consider that possibility. I'm not sure the comparison code in the sort is necessary — it ensures that the comparisons are numeric, though. If the numbers are all the same length and zero-padded on the left when necessary, there's no problem. If they're more generally formatted, the 'forced numeric' comparison might make a difference.
Remember: this is Perl, so TMTOWDTI (There's More Than One Way To Do It). Someone else might come up with a simpler solution.
Desired output can be achieved with following code snippet
look for pattern :\d+: in a line
increment hash %count for the digit
output result to console
use strict;
use warnings;
use feature 'say';
my %count;
/:(\d+):/ && $count{$1}++ for <>;
say "$_ = $count{$_}" for sort keys %count;

Reading data from file into an array to manipulate within Perl script

New to Perl. I need to figure out how to read from a file, separated by (:), into an array. Then I can manipulate the data.
Here is a sample of the file 'serverFile.txt' (Just threw in random #'s)
The fields are Name : CPU Utilization: avgMemory Usage : disk free
Server1:8:6:2225410
Server2:75:68:64392
Server3:95:90:12806
Server4:14:7:1548700
I would like to figure out how to get each field into its appropriate array to then perform functions on. For instance, find the server with the least amount of free disk space.
The way I have it set up now, I do not think will work. So how do I put each element in each line into an array?
#!usr/bin/perl
use warnings;
use diagnostics;
use v5.26.1;
#Opens serverFile.txt or reports and error
open (my $fh, "<", "/root//Perl/serverFile.txt")
or die "System cannot find the file specified. $!";
#Prints out the details of the file format
sub header(){
print "Server ** CPU Util% ** Avg Mem Usage ** Free Disk\n";
print "-------------------------------------------------\n";
}
# Creates our variables
my ($name, $cpuUtil, $avgMemUsage, $diskFree);
my $count = 0;
my $totalMem = 0;
header();
# Loops through the program looking to see if CPU Utilization is greater than 90%
# If it is, it will print out the Server details
while(<$fh>) {
# Puts the file contents into the variables
($name, $cpuUtil, $avgMemUsage, $diskFree) = split(":", $_);
print "$name ** $cpuUtil% ** $avgMemUsage% ** $diskFree% ", "\n\n", if $cpuUtil > 90;
$totalMem = $avgMemUsage + $totalMem;
$count++;
}
print "The average memory usage for all servers is: ", $totalMem / $count. "%\n";
# Closes the file
close $fh;
For this use case, a hash is much better than an array.
#!/usr/bin/perl
use strict;
use feature qw{ say };
use warnings;
use List::Util qw{ min };
my %server;
while (<>) {
chomp;
my ($name, $cpu_utilization, $avg_memory, $disk_free)
= split /:/;
#{ $server{$name} }{qw{ cpu_utilization avg_memory disk_free }}
= ($cpu_utilization, $avg_memory, $disk_free);
}
my $least_disk = min(map $server{$_}{disk_free}, keys %server);
say for grep $server{$_}{disk_free} == $least_disk, keys %server;
choroba's answer
is ideal, but I think your own code could be improved
Don't use v5.26.1 unless you need a specific feature that is available only in the given version of Perl. Note that it also enables use strict, which should be at the top of every Perl program you write
die "System cannot find the file specified. $!" is wrong: there are multiple reasons why an open may fail, beyond that it "cannot be found". Your die string should include the path to the file you're trying to open; the reason for the failure is in $!
Don't use subroutine prototypes: they don't do what you think they do. sub header() { ... } should be just sub header { ... }
There's no point in declaring a subroutine only to call it a few lines later. Put your code for header in line
You have clearly come from another language. Declare your variables with my as late as possible. In this case only $count and $totalMem must be declared outside the while loop
perl will close all open file handles when the program exits. There is rarely a need for an explicit close call, which just makes your code more noisy
$totalMem = $avgMemUsage + $totalMem is commonly written $totalMem += $avgMemUsage
I hope that helps
To your original question about how to store the data in an array...
First, initialize an empty array outside the file read loop:
my #servers = ();
Then, within the loop, after you have your data pieces parsed out, you can store them in your array as sub-arrays (the resulting data structure is a two dimensional array):
$servers[$count] = [ $name, $cpuUtil, $avgMemUsage, $diskFree ];
Note, the square brackets on the right create the sub-array for the server's data pieces and return a reference to this new array. Also, on the left side we just use the current value of $count as an index within the #servers array and as the value increases, the size of the #servers array will grow automatically (this is called autovivification of new elements). Alternatively, you can push new elements onto the #servers array inside the loop, like this:
push #servers, [ $name, $cpuUtil, $avgMemUsage, $diskFree ];
This way, you explicitly ask for a new element to be added to the array and the square brackets still do the same creation of the sub-array.
In any case, the end result is that after you are finished with the file read loop, you now have a 2D array where you can access the first server and its disk free field (the 4-th field at index 3) like this:
my $df = $servers[0][3];
Or inspect all the servers in a loop to find the minimum disk free:
my $min_s = 0;
for ( my $s = 0; $s < #servers; $s++ ) {
$min_s = $s if ( $servers[$s][3] < $servers[$min_s][3] );
}
print "Server $min_s has least disk free: $servers[$min_s][3]\n";
Like #choroba suggested, you can store the server data pieces/fields in hashes, so that your code will be more readable. You can still store your list of servers in an array but the second dimension can be hash:
$servers[$count] = {
name => $name,
cpu_util => $cpuUtil,
avg_mem_usage => $avgMemUsage,
disk_free => $diskFree
};
So, your resulting structure will be an array of hashes. Here, the curly braces on the right create a new hash and return the reference to it. So, you can later refer to:
my $df = $servers[0]{disk_free};

Adding a key value pair in hash, by assigning an array in the value => Can't use an undefined value as an ARRAY reference

I'm trying to assign an array in a hash key-value pair as a value of a key. After assigning it i'm trying to dereference it and print the array values from the specific key in an output file as you can see from the code below.
The code is not working well on the array manipulation part. Can someone tell me what I'm doing wrong?
use strict;
use warnings;
use Data::Dumper;
# File input
my $in_file = 'log.txt';
# Output file
my $out_file_name = 'output.csv';
open(my $fout, '>', $out_file_name);
# print header csv
print $fout "Col1\,Col2\,Col3\,Col4\,Col5\n";
# Read the input file
open(FH, '<', $in_file) or die "Could not open file '$in_file' $!";
my #log_file = <FH>;
# print Dumper(#log_file),"\n";
close (FH);
# my #test_val;
my ($read, $ref, $val_county, $val_rec, $val_tar, $val_print, #test_values, $status);
foreach(#log_file) {
# print $_;
if ($_ =~ /\t+(?<county_name>(?!Total).+)\s+/i) {
$ref->{code} = $+{county_name};
$val_county = $ref->{code};
} elsif ($_ =~ /^Total\s+records\s+in\s+TAR\s+\(pr.+\)\:\s+(?<tar_records>.+)$/i) {
$ref->{code} = $val_county;
push(#test_values, $+{tar_records});
$ref->{tar_rec} = \#test_values;
# $val_rec = $ref->{tar_rec};
# $val_rec =~ s/\.//g;
}
&print_file($ref);
}
sub print_file {
my $ref = shift;
my $status = shift;
print $fout join(",", $ref->{code}, [#{$ref->{tar_rec}}]), "\n"; # Line 68
print Dumper($ref);
}
close $fout;
print "Done!","\n";
The code is a providing an error like:
"Can't use an undefined value as an ARRAY reference at test_array_val_hash.pl line 68."
Until the second regex in your forloop block is matched, the $ref->{tar_rec} key will not be assigned a value - and will be undefined. The following snippet - based on your own code - highlights the issue.
#!/usr/bin/perl -w
my #tar_records = (15,35,20);
my $ref = {
code => 'Cork',
tar_rec => \#tar_records,
};
sub print_info {
my $ref = shift;
print join(", ", $ref->{code}, (#{$ref->{tar_rec}})), $/;
}
print_info($ref);
# Once we 'undefine' the relevant key, we witness the afore-
# mentioned error.
undef $ref->{tar_rec};
print_info($ref);
To avoid this error, you could assign an anonymous array reference to $ref->{tar_rec} key before the for loop (since $ref->{tar_rec} is a cumulative value).
# Be sure not to declare $ref twice!
my ($read, $val_county, $val_rec, $val_tar, $val_print, #test_values, $status);
my $ref = {
code => '',
tar_rec => [],
}
P.S. Notice also that I used round brackets rather than square brackets in the join() function (although you actually don't need either).
The problem is that you're calling print_file in the wrong place.
Imagine that you're parsing the file a line at a time. Your code parses the first line and that populates $ref->{code}. But then you call print_file on a partially populated $ref so it doesn't work.
Your code is also not resetting any of the variables used, so as it progresses through the file, the contents of $ref are going to grow.
The code below fixes the first problem by implicitly setting an empty array in $ref->{tar_rec} and only printing out the record when it's starting a new one or when it's finished reading in the file. Since $ref->{tar_rec} is an array it solves the other problem by allowing you to directly push into it rather than relying upon #test_values. Just for added safety it assigns an empty hash to $ref.
if(open(my $fh, '<', $in_file)) {
my $ref;
my $val_county;
foreach(<$fh>) {
# print $_;
if ($_ =~ /\t+(?<county_name>(?!Total).+)\s+/i) {
if(defined($val_county)) {
print_file($ref);
}
$ref={};
$val_county = $+{county_name};
$ref->{code} = $val_county;
$ref->{tar_rec} = [];
} elsif ($_ =~ /^Total\s+records\s+in\s+TAR\s+\(pr.+\)\:\s+(?<tar_records>.+)$
push #{$ref->{tar_rec}}, $+{tar_records};
}
}
if(defined($ref)) {
print_file($ref);
}
close($fh);
} else {
die "Could not open file '$in_file' $!";
}
You're also printing out the array incorrectly
print $fout join(",", $ref->{code}, [#{$ref->{tar_rec}}]), "\n";
you don't need any brackets around #{$ref->{tar_rec}} - it'll be treated as a list of values to pass to join as is.
print $fout join(",", $ref->{code}, #{$ref->{tar_rec}}), "\n";

get param function array in perl

I want to get the array that I send in my function but it seem's to be empty.
I call send_file(); with an array in the param
send_file($addr, #curfile);
And this is the way I get back the param
sub send_file($$)
{
my $addr = $_[0];
my #elem = #_;
...
}
Why my #elem is empty ? How could I get back the array without losing everything ?
Don't use prototypes. Their purpose is to change parsing of the source which you don't need.
sub send_file
{
my $addr = shift;
my #elem = #_;
...
}
send_file($addr, #curfile);
You should pass your array by reference instead:
#!/usr/bin/perl
use strict;
use warnings;
my $test_scalar = 10;
my #test_array = qw(this is a test);
sub test($\#)
{
my ($scalar, $array) = #_;
print "SCALAR = $scalar\n";
print "ARRAY = #$array\n";
}
test($test_scalar, #test_array);
system 'pause';
Output:
SCALAR = 10
ARRAY = this is a test
Press any key to continue . . .
EDIT:
If you would like to do the same thing without passing by reference change your $$ to $# and use shift so the first argument doesn't end up included in your array. Passing arrays by reference is better coding practice though . . . This is just to show you how it can be done without passing by reference:
#!/usr/bin/perl
use strict;
use warnings;
my $test_scalar = 10;
my #test_array = qw(this is a test);
sub test($#)
{
my ($scalar, #array) = #_;
print "SCALAR = $scalar\n";
print "ARRAY = #array\n";
}
test($test_scalar, #test_array);
system 'pause';
This will get you the same output.
You can also get rid of the $# altogether if you would like it really isn't necessary.
Why my #elem is empty ?
Your #elem is not empty, it has exactly two elements. First is value of $addr and second is size/number of elements in #curfile array. This is due $$ prototype definition which requires two scalars, so scalar #curfile is passed as second parameter.
How could I get back the array without loosing everything ?
Since you're not using prototype advantages, just omit prototype part,
sub send_file {
my ($addr, #elem) = #_;
...
}

Perl - can't use string (...) as an array ref

I'm practicing Perl with a challenge from codeeval.com, and I'm getting an unexpected error. The goal is to iterate through a file line-by-line, in which each line has a string and a character separated by a comma, and to find the right-most occurrence of that character in the string. I was getting wrong answers back, so I altered the code to print out just variable values, when I got the following error:
Can't use string ("Hello world") as an ARRAY ref while "strict refs" in use at char_pos.pl line 20, <FILE> line 1.
My code is below. You can see a sample from the file in the header. You can also see the original output code, which was incorrectly only displaying the right-most character in each string.
#CodeEval challenge: https://www.codeeval.com/open_challenges/31/
#Call with $> char_pos.pl numbers
##Hello world, d
##Hola mundo, H
##Keyboard, b
##Connecticut, n
#!/usr/bin/perl
use strict;
use warnings;
my $path = $ARGV[0];
open FILE, $path or die $!;
my $len;
while(<FILE>)
{
my #args = split(/,/,$_);
$len = length($args[0]) - 1;
print "$len\n";
for(;$len >= 0; $len--)
{
last if $args[0][$len] == $args[1];
}
#if($len > -1)
#{
# print $len, "\n";
#}else
#{
# print "not found\n";
#}
}
EDIT:
Based on the answers below, here's the code that I got to work:
#!/usr/bin/perl
use strict;
use warnings;
use autodie;
open my $fh,"<",shift;
while(my $line = <$fh>)
{
chomp $line;
my #args = split(/,/,$line);
my $index = rindex($args[0],$args[1]);
print $index>-1 ? "$index\n" : "Not found\n";
}
close $fh;
It looks like you need to know a bit about Perl functions. Perl has many functions for strings and scalars and it's not always possible to know them all right off the top of your head.
However, Perl has a great function called rindex that does exactly what you want. You give it a string, a substring (in this case, a single character), and it looks for the first position of that substring from the right side of the string (the index does the same thing from the left hand side.)
Since you're learning Perl, it may be a good idea to get a few books on Modern Perl and standard coding practices. This way, you know newer coding techniques and the standard coding practices.
Modern Perl - Gives you newer programming help.
Learning Perl - An old standard.
Perl Best Practices - The standard coding practices.
Here's a sample program:
#!/usr/bin/perl
use strict;
use warnings;
use autodie;
use feature qw(say);
open my $fh, "<", shift;
while ( my $line = <$fh> ) {
chomp $line;
my ($string, $char) = split /,/, $line, 2;
if ( length $char != 1 or not defined $string ) {
say qq(Invalid line "$line".);
next;
}
my $location = rindex $string, $char;
if ( $location != -1 ) {
say qq(The right most "$char" is at position $location in "$string".);
}
else {
say qq(The character "$char" wasn't found in line "$line".)";
}
close $fh;
A few suggestions:
use autodie allows your program to automatically die on bad open. No need to check.
Three parameter open statement is now considered de rigueur.
Use scalar variables for file handles. They're easier to pass into subroutines.
Use lexically scoped variables for loops. Try to avoid using $_.
Always do a chomp after a read.
And most importantly, error check! I check the format of the line to make sure that's there is only a single comma, and that the character I'm searching for is a character. I also check the exit value of rindex to make sure it found the character. If rindex doesn't find the character, it returns a -1.
Also know that the first character in a line is 0 and not 1. You may need to adjust for this depending what output you're expecting.
Strings in perl are a basic type, not subscriptable arrays. You would use the substr function to get individual characters (which are also just strings) or substrings from them.
Also note that string comparison is done with eq; == is numeric comparison.
while($i=<DATA>){
($string,$char)=split(",",$i);
push(#str,$string);}
#join=split("",$_), print "$join[-1]\n",foreach(#str);
__DATA__
Hello world, d
Hola mundo, H
Keyboard, b
Connecticut, n

Resources