foreach printing array elements - perl

I'm trying to loop through multiple array elements, and based on the array, I'm trying print each element with its corresponding value.
#_disk = ('0:0','0:1');
#_diskStatus= ('OK','Critical');
Here is what I have tried, I'm not sure how to use conditions to get desired output:
foreach (#_diskID, #_diskStatus)
{
# Print the data in JSON
print "\t,\n" if not $_first;
$_first = 0;
print "\t{\n";
print "\t\t\"{#DISKID}\":\"$_\"\n";
print "\n\t}\n";
}
print "\n\t]\n";
print "}\n";
Desired output
{
"data":[
{
"{#DISKID}":" 0:0"
}
,
{
"{#STATUS}":" Ok"
}
,
{
"{#DISKID}":" 0:1"
}
,
{
"{#STATUS}":" Critical"
}
]
}

If both arrays are always the same size, it would be simpler to loop through the indexes of the array than the actual elements.
# only need one array here because they are the same size
foreach my $i ( 0 .. $#_diskID ) {
...
}
Also there is no need to build up a JSON string like this in Perl, there is a nice module on CPAN called JSON which can create them for your from a hash.
So, knowing this you can simply create a hash:
use strict;
use warnings;
use JSON;
my #_disk = ('0:0','0:1');
my #_diskStatus= ('OK','Critical');
my %json_hash = ( data => [] );
foreach my $i ( 0 .. $#_disk ) {
push #{$json_hash{data}},
{ '{#DISKID}' => $_disk[$i],
'{#STATUS}' => $_diskStatus[$i],
};
}
my $json_string = encode_json \%json_hash;
print "$json_string\n";
# prints
# {"data":[{"{#STATUS}":"OK","{#DISKID}":"0:0"},{"{#DISKID}":"0:1","{#STATUS}":"Critical"}]}

Assuming both arrays have the same number of elements:
use warnings;
use strict;
my #_disk = ('0:0','0:1');
my #_diskStatus = ('OK','Critical');
for my $i (0 .. $#_disk) {
print "$_disk[$i] $_diskStatus[$i]\n";
}

Related

Split string into a hash of hashes (perl)

at the moment im a little confused..
I am looking for a way to write a string with an indefinite number of words (separated by a slash) in a recursive hash.
These "strings" are output from a text database.
Given is for example
"office/1/hardware/mouse/count/200"
the next one can be longer or shorter..
This must be created from it:
{
office {
1{
hardware {
mouse {
count => 200
}
}
}
}
}
Any idea ?
Work backwards. Split the string. Use the last two elements to make the inner-most hash. While more words exist, make each one the key of a new hash, with the inner hash as its value.
my $s = "office/1/hardware/mouse/count/200";
my #word = split(/\//, $s);
# Bottom level taken explicitly
my $val = pop #word;
my $key = pop #word;
my $h = { $key => $val };
while ( my $key = pop #word )
{
$h = { $key => $h };
}
Simple recursive function should do
use strict;
use warnings;
use Data::Dumper;
sub foo {
my $str = shift;
my ($key, $rest) = split m|/|, $str, 2;
if (defined $rest) {
return { $key => foo($rest) };
} else {
return $key;
}
}
my $hash = foo("foo/bar/baz/2");
print Dumper $hash;
Gives output
$VAR1 = {
'foo' => {
'bar' => {
'baz' => '2'
}
}
};
But like I said in the comment: What do you intend to use this for? It is not a terribly useful structure.
If there are many lines to be read into a single hash and the lines have a variable number of fields, you have big problems and the other two answers will clobber data by either smashing sibling keys or overwriting final values. I'm supposing this because there is no rational reason to convert a single line into a hash.
You will have to walk down the hash with each field. This will also give you the most control over the process.
our $hash = {};
our $eolmark = "\000";
while (my $line = <...>) {
chomp $line;
my #fields = split /\//, $line;
my $count = #fields;
my $h = $hash;
my $i = 0;
map { (++$i == $count) ?
($h->{$_}{$eolmark} = 1) :
($h = $h->{$_} ||= {});
} #fields;
}
$h->{$_}{$eolmark} = 1 You need the special "end of line" key so that you can recognize the end of a record and still permit longer records to coexist. If you had two records
foo/bar/baz foo/bar/baz/quux, the second would overwrite the final value of the first.
$h = $h->{$_} ||= {} This statement is a very handy idiom to both create and populate a cache in one step and then take a shortcut reference to it. Never do a hash lookup more than once.
HTH

Passing arrays in Perl

All right, I'll try to explain what I've done so far. I'm using a Parellel::ForkManager to grab data from an array of URLs, which is then stored in variables (value1, value2, value3).
I then collect the data from all of those processes, and display the data with $pm->run_on_finish.
#...
my $pm = new Parallel::ForkManager(10);
$pm->run_on_finish (
sub {
my #info = #{$data_structure_reference};
print $info[0];
print $info[1];
print $info[2];
}
);
for my $var (#urls) {
$pm->start and next;
#...
#returned = &something($var);
#...
$pm->finish(0, \#returned);
}
sub something {
#... getting data from each URL and storing it in variables
my #array = (
$value1,
$value2,
$value3
);
return #array;
}
Now, what I want to do, is to pass an array, #value4, as well, and then only display that data if there is something in the array. So, I want it to look like this:
sub something {
#... getting data from each URL and storing it in variables
my #array = (
$value1,
$value2,
$value3,
#value4
);
return #array;
}
And then I want it to print that array, only if there is something in it.
Unfortunately, I'm not entirely sure how to go about doing that.
I assume that what you are asking is how to return an array along with the three scalars returned from the something() sub, and print it?
I also assume that those three scalars are what's referred to as being in #info.
The simplest way seems to me to be to simply tack them to the end of the array you return, use the three first values, and if there's anything left, print that too.
$pm->run_on_finish (
sub {
my #info = #{$data_structure_reference};
print splice #info, 0, 3;
print #info if (#info);
}
);
sub something {
return (
$value1,
$value2,
$value3,
#value4
);
}
As you'll notice, you do not need to fill a dummy array for the return value, simply return values inside the parens. You do not need to dereference the array, since you can use the #info array straight up if you splice off the first three values.
I like it simple. If it works.
I've previously provided a simple solution to this problem. It can use threads (use threads;) or processes (use forks;).
use threads; # or: use forks;
use Thread::Queue qw( );
use constant NUM_WORKERS => 10;
my $request_q = Thread::Queue->new();
my $response_q = Thread::Queue->new();
# Create the workers.
for (1..NUM_WORKERS) {
(async {
while (defined(my $request = $request_q->dequeue())) {
$response_q->enqueue(process_request($request));
}
})->detach();
}
# Submit work to workers.
$request_q->enqueue(#requests);
# Signal the workers they are done.
$request_q->enqueue(undef) for 1..NUM_WORKERS;
# Collect the results.
my $working = NUM_WORKERS;
while ($working) {
my $result = $response_q->dequeue();
if (!defined($result)) {
--$working;
next;
}
process_response($result);
}
The work to be done in the children is done by process_request.
sub process_request {
# ...
return [
$value1,
$value2,
$value3,
\#value4,
];
}
The results are passed to process_response in the parent.
sub process_response {
my ($value1, $value2, $value3, $value4) = #{ $_[0] };
...
}
I am not totally sure what you are asking, but in order to pass multiple arrays to a function in Perl one must pass by reference.
my #array1 = (1, 2, 3);
my #array2 = ('a', 'b', 'c');
&fn(\#array1, \#array2);
In order to print an array only in the case when it has value, one must simply check that it has value and print it:
print "#array" if #array;
Though, the nice function of "#array" is that if #array has no value then "#array" evaluates to "". This allows you to reduce the previous statement to a simple:
print "#array"

split array in sections

I have an array with this type of content
a/a/a/test134.html
a/a/a/test223.html
a/b/b/test37.html
a/b/test41.html
a/b/test44.html
a/b/test432.html
a/d/test978.html
a/test.html
I need to split it by "directories" so that I can send each array for a directory into a function (please see code sample).
a/a/a/test134.html
a/a/a/test223.html
a/b/b/test37.html
a/b/test41.html
a/b/test44.html
a/b/test432.html
a/d/test978.html
a/test.html
This is what I have so far but I feel theres lots of bugs especially on end and beginning cases and is not clean enough to my liking.
for(my $i = 0; $i < scalar(#arrayKeys); $i++)
{
my($filename, $directory) = fileparse($arrayKeys[$i]);
my $currDir = $directory;
# $currDir ne $prevDir: takes care of changes in path
# $i + 1 == scalar(#arrayKeys): accounts for last row to be purged
if($currDir ne $prevDir || $i + 1 == scalar(#arrayKeys))
{
# if last row we need to push it
if($i + 1 == scalar(#arrayKeys))
{
push(#sectionArrayKeys, $arrayKeys[$i]);
}
# ensure for first entry run we don't output
if ($prevDir ne "")
{
&output(\#sectionArrayKeys);
}
# Clear Array and start new batch
#sectionArrayKeys = ();
push(#sectionArrayKeys, $arrayKeys[$i]);
}
else
{
push(#sectionArrayKeys, $arrayKeys[$i]);
}
$prevDir = $currDir;
}
Your script is confusing, but from what I understand, you want to split the array of paths into new arrays, depending on their path. Well, easiest way to keep them apart is using a hash, like so:
use warnings;
use strict;
my %dir_arrays;
while (<DATA>) {
chomp;
if (m{^(.+/)([^/]+)$}) {
push #{$dir_arrays{$1}}, $_; # or use $2 for just filename
}
}
use Data::Dumper;
print Dumper \%dir_arrays;
__DATA__
a/a/a/test134.html
a/a/a/test223.html
a/b/b/test37.html
a/b/test41.html
a/b/test44.html
a/b/test432.html
a/d/test978.html
a/test.html
Output:
$VAR1 = {
'a/b/' => [
'a/b/test41.html',
'a/b/test44.html',
'a/b/test432.html'
],
'a/d/' => [
'a/d/test978.html'
],
'a/b/b/' => [
'a/b/b/test37.html'
],
'a/a/a/' => [
'a/a/a/test134.html',
'a/a/a/test223.html'
],
'a/' => [
'a/test.html'
]
};
Now, to send these arrays to a function, do something like this:
for my $key (keys %dir_arrays) {
my_function($dir_arrays{$key}); # this sends an array reference
}
If you prefer to send an array instead of an array reference, just dereference it:
my_function(#{$dir_arrays{$key}});
Edit: Changed the script to store the full path, as it was more in line with the wanted output in the question.

How can I apply a function to a list using map?

I want to apply a function to every item of a list and store results similar to map(function, list) in python.
Tried to pass a function to map, but got this error:
perl -le 'my $s = sub {}; #r = map $s 0..9'
panic: ck_grep at -e line 1.
What's the proper way to do this?
If a scalar variable holds a code reference -- for example:
my $double = sub { 2 * shift };
You can invoke the code very much the way you would in Python, like this:
$double->(50); # Returns 100.
Applying that to a map example:
my #doubles = map $double->($_), 1..10;
Or this way:
my #doubles = map { $double->($_) } 1..10;
The second variant is more robust because the block defined by the {} braces can contain any number of Perl statements:
my #doubles = map {
my $result = 2 * $_;
# Other computations, if needed.
$result; # The return of each call to the map block.
} 1..10;
my $squared = sub {
my $arg = shift();
return $arg ** 2;
};
then either
my #list = map { &$squared($_) } 0 .. 12;
or
my #list = map { $squared->($_) } 0 .. 12;
or maybe
my $squared;
BEGIN {
*Squared = $squared = sub(_) {
my $arg = shift();
return $arg ** 2;
};
}
my #list = map { Squared } 0 .. 12;
try : map { $s->($_) } (0..9) instead of map $s 0..9
explanation : in you example, $s is a reference to a subroutine, so you must dereference it to allow subroutin calling. This can be achieved in several ways : $s->() or &$s() (and probably some other ways that I'm forgetting)
It's not too different from Python.
#results = map { function($_) } #list;
#results = map function($_), #list;
or with "lambdas",
#results = map { $function->($_) } #list;
#results = map $function->($_), #list;

Mapping values with Column header and row header

I have some files with below data.
sample File 1:
sitename1,2009-07-19,"A1",11975,17.23
sitename1,2009-07-19,"A2",11,0.02
sitename1,2009-07-20,"A1",2000,17.23
sitename1,2009-07-20,"A2",538,0.02
I want to map the values in column 4 with column 2 and 3 as shown below.
Output required.
Site,Type,2009-07-19,2009-07-20
sitename1,"A1",11975,2000
sitename1,"A2",11,538
Here is what I have tried so far:
#! /usr/bin/perl -w
use strict;
use warnings;
my $column_header=["Site,Type"];
my $position={};
my $last_position=0;
my $current_event=[];
my $events=[];
while (<STDIN>) {
my ($site,$date,$type,$value,$percent) = split /[,\n]/, $_;
my $event_key = $date;
if (not defined $position->{$event_key}) {
$last_position+=1;
$position->{$event_key}=$last_position;
push #$column_header,$event_key;
}
my $pos = $position->{$event_key};
if (defined $current_event->[$pos]) {
dumpEvent();
}
if (not defined $current_event->[0]) {
$current_event->[0]="$site,$type";
}
$current_event->[$pos]=$value;
}
dumpEvent();
my $order = [];
for (my $scan=0; $scan<scalar(#$column_header); $scan++) {
push #$order,$scan;
}
printLine($column_header);
map { printLine($_) } #$events;
sub printLine {
my $record=shift;
my #result=();
foreach my $offset (#$order) {
if (defined $record->[$offset]) {
push #result,$record->[$offset];
} else {
push #result,"";
}
}
print join(",",#result)."\n";
}
sub dumpEvent {
return unless defined $current_event->[0];
push #$events,$current_event;
$current_event=[];
}
The output i am getting is as below.
*Site,Type,2009-07-19,2009-07-20*
sitename1,"A1",11975,
sitename1,"A2",11,
sitename1,"A1",,14620
sitename1,"A2",,538
If I understand you correctly (and I have to admit I'm only guessing), you have several types of things at different dates and a value for each. Thus you need a data structure like this hash for each site:
$foo = {
site => 'sitename1',
type => 'A1',
dates => [
{
date => '2009-07-19',
value => 11975,
},
{
date => '2009-07-20',
value => 538,
},
],
};
Is that even close?
The folowing code produces the expected result and makes "some" sense. I don't know if it makes real sense.
my %dates;
my %SiteType;
while (<DATA>) {
chomp;
my ($site,$date,$type,$value,$percent) = split /,/;
$dates{$date} = '1';
push #{$SiteType{"$site,$type"}}, $value ;
};
print 'Site,Type,', join(',', sort keys %dates), "\n";
foreach ( sort keys %SiteType) {
print $_, ',', join(',', #{$SiteType{$_}}), "\n";
};