how to increment hash of hash in perl - perl

failing to properly populate a HoH using this code:
when i run the loop using below:
while (my $form = $form_rs->next ()){
my $menu=$form->get_column("fmenu");
my $script=$form->get_column("fscript");
my $name=$form->get_column("ftitle");
$itemList->{$menu} = {
$script => $name
};
}
print Dumper $itemList;
it runs correctly but since $menu is repeating it only keeps last value in the HoH. So i get erroneous output in Data Dumper. I get only 1 record for each 'menu', whereas there should be many.
getting:
itemList=>{
menu1=>{
script1=>formName1
},
menu2=>{
script3=>formName3
}
...(and so on)
}
whereas EXPECTED:
itemList=>{
menu1=>{
script1=>formName1,
script2=>formName2
},
menu2=>{
script3=>formName3,
...(and so on)
}
...(and so on)
}
pl help.
thank you.

Then you want to update $itemList->{$menu}{$script} rather than assign a reference to a one-element hash to $itemList->{$menu}.
$itemList->{$menu}{$script} = $name;

Related

Perl get all values from hahes inside of array

I`m really struggling with Perl and I need to solve this topic. I Have a rest api response that I converted to json, Dumper shows something like this:
VAR1= [
{
"id":"abc",
"type":"info",
"profile":
{"name":"Adam",
"description":"Adam description"}
},
{
"id":"efg",
"type":"info",
"profile":
{"name":"Jean",
"description":"Jean description"}
},
{
"id":"hjk",
"type":"info",
"profile":
{"name":"Jack",
"description":"Jack description"}
},
]
What I need is to iterate over each "name" and check if value is Jean. I wanted to iterate over hashes inside of array, but each time it will only store first hash, not all of them.
What I`m trying and failing:
# my json gather, Dumper is shown above.
my $result_json = JSON::from_json($rest->GET( $host, $headers )->{_res}->decoded_content);
# I`ve tried many things to get all hashes, but either error, or single hash, or single value:
my $list = $result_json->[0];
my $list2 = $result_json->[0]->{'profile'};
my $list3 = #result_json->[0];
my $list4 = #result_json->[0]->{'profile'};
my $list5 = #result_json;
my $list5 = #result_json->{'profile'}; # this throws error
my $list6 = #result_json->[0]->{'profile'}->{'name'};
my $list7 = $result_json->[0]->{'profile'}->{'name'};
# and maybe more combinations... its just an example.
foreach my $i (<lists above>){
print $i;
};
Any idea how to set it up properly and iterate over each "name"?
Assuming that the call to JSON::from_json shown in the code smaple is indeed given the JSON string shown as a Dumper output,† that $result_json is an array reference so iterate over its elements (hash references)
foreach my $hr (#{ $result_json }) {
say "profile name: ", $hr->{profile}{name};
}
† That last comma in the supposed Dumper's output can't actually be there, so I removed it to use the rest as a sample JSON for testing

Get blob uploaded data with pure Perl

In Javascript, I am sending a blob using XHR by the following code:
var v=new FormData();
v.append("EFD",new Blob([...Uint8Array...]));
var h=new XMLHttpRequest();
h.setRequestHeader("Content-type","multipart/form-data; charset=utf-8");
h.open("POST","...url...");
h.send(v);
In the server, I have created in Perl the following function, that suppose to implement CGI->param and CGI->upload:
# QS (Query String) receive in argument string for single parameter or array of many required parameters.
# If string been supplied: Return the value of the parameter or undef if missing.
# If array been supplied, a hash will be returned with keys for param names and their corresponding values.
# If the first argument is undef, then return hash with ALL available parameters.
sub QS {
my $b=$ENV{'QUERY_STRING'};
if($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN,$b,$ENV{'CONTENT_LENGTH'}) or die "E100";
}
my $e=$_[0]; my $t=&AT($e); my $r={}; my #q=split(/&/,$b);
my %p=(); if($t eq "A") { %p=map { $_=>1 } #{$e}; }
foreach my $i(#q) {
my ($k,$s)=split(/=/,$i); $s=~tr/+//; $s=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
if($t eq "") { $r->{$k}=$s; }
elsif($t eq "A") { if($p{$k}) { $r->{$k}=$s; } }
elsif($k eq $_[0]) { return $s; }
}
return $r;
}
# AT is a function for determining type of an object, and also a quck way to distinguish between just a string and a number.
sub AT {
if(!defined $_[0]) { return ""; } my $v=ref($_[0]);
if($v eq "") { return ($_[0]*1 eq $_[0])?"N":"S"; }
my $k={"ARRAY"=>"A","HASH"=>"H"};
return $k->{$v}||$_[0]->{_obt}||$v;
}
So in the main program it will be called as:
my $EFD=&FW::QS("EFD"); # FW = The module name where QS and AT are.
When I issuing the POST from the client, the script in the server does not pop-up any errors, and does not terminates - it continues to run and run and run.... Endlessly.... Consuming 100% CPU time and 100% memory - without any explanation.
I have these in the beginning of the script, though:
use strict;
use warnings;
use diagnostics;
but it still behave in such a way that I need to kill the script in order to terminate it...
Anyone know what I did wrong...? No infinite loop here, as far as I know... If I change the Blob to regular classic way of "...url...?EFD=dhglkhserkhgoi" then it works just fine, but I want a Blob....
Thanks a lot
This QS function is only usable for POSTs with an application/x-www-urlencoded body, which yours isn't.

MongoDB/Perl: find_one doesn't return data after unrelated code

mongodb is v4.0.5
Perl is 5.26.3
MongoDB Perl driver is 2.0.3
This Data::Dumper output shows what's driving me crazy
INFO - $VAR1 = [
'275369249826930689 1',
{
'conf' => {
'param' => 'argument'
},
'id' => '275369249826930689',
'lastmsg' => '604195211232139552',
'_id' => bless( {
'oid' => ']:\',&�h�GeR'
}, 'BSON::OID' )
}
];
352832438449209345 275369249826930689
INFO - $VAR1 = [
'275369249826930689 2'
];
The second INFO - $VAR1 should show the same content as the first one. This is the original code, which I have (see below) broken down to find the culprit.
ddump(["$userid 1",
$c_identities->find_one({
channel => 'chan1',
id => $userid,
})
]);
my #filtered = reverse
grep { $_->{author}->{id} == $userid } #{$answers};
ddump(["$userid 2",
$c_identities->find_one({
channel => 'chan1',
id => $userid,
})
]);
ddump is just a wrapper for Data::Dumper. If I remove the "my #filtered" line, the second find one again returns the expected result (a MongoDB document). $answers is just a listref of hashes - no objects - from some API, completely unrelated to MongoDB.
So I broke the "reverse grep" code down to see where the culprit is. The say are the two numbers you see between the dumpers above. This is what I can do, to get answer from the second find_one:
for my $answer (#{$answers}) {
say $answer->{author}->{id}, ' ', $userid;
push #filtered, $answer;
}
As long as I do just this, the second find_one delivers a result. If, however, I do this:
for my $answer (#{$answers}) {
say $answer->{author}->{id}, ' ', $userid;
if ($answer->{author}->{id} == $userid) {
}
push #filtered, $answer;
}
I get the output from above (where the second dumper yields no return from the find_one. It's insane - the if-clause containing the numeric eq causes the second find_one to fail! This is also the grep body in the intended code.
What's going on here? How can this have possibly any effect on the MongoDB methods?
Using the numeric comparison operator == numifies the value, but it's probably too large to fit into an integer and becomes a float. It can also just become an integer and lose double quotes when serialized to JSON or similar format. Using eq instead of == keeps the value unchanged.

VMware vCLI Perl "who done it" script

I've been trying to do this for a while and I just can't seem to understand the vCLI SDK. I believe the MO that I want to use is
ServiceContent->Task Manager, then print out the recent task. Here is my subroutine for doing it:
sub TaskManager {
my $begin;
my $mor = Vim::get_service_content()->taskManager;
my $taskmanager_view = Vim::get_view(mo_ref => $mor);
my $my_filterSpec = TaskFilterSpec->new();
my $eventArray = $taskmanager_view->CreateCollectorForTasks(filter => $my_filterSpec);
foreach (#$eventArray) {
# my $collector_view = Vim::get_view(mo_ref => $eventArray);
print $_->recentTask . "\n";
}
}
When I run this I either get:
Not an ARRAY reference at ./TaskManager.pl line 43.
When I change this, I then get:
subroutine &ManagedObjectReference::recentTask called at ./TaskManager.pl line 45
Here's one of the DOCS I've been looking at
https://www.vmware.com/support/developer/vc-sdk/visdk400pubs/ReferenceGuide/vim.TaskManager.html
I also have some conversations happening here:
https://www.reddit.com/r/vmware/comments/4qfaql/help_with_vcli_perl_script/
EDIT: I changed my subroutine to the following:
sub TaskManager {
my $begin;
my $mor = Vim::get_service_content()->taskManager;
my $taskmanager_view = Vim::get_view(mo_ref => $mor);
my $my_filterSpec = TaskFilterSpec->new();
my $eventArray = $taskmanager_view->CreateCollectorForTasks(filter => $my_filterSpec);
foreach ($eventArray) {
my $newRecentTask = $taskmanager_view->description;
print $newRecentTask . "\n";
}
}
But the problem is that the print statement is returning a hash value, not something I can use. Any ideas how to get something readable?

Perl referencing and deferencing hash values when passing to subroutine?

I've been banging my head over this issue for about 5 hours now, I'm really frustrated and need some assistance.
I'm writing a Perl script that pulls jobs out of a MySQL table and then preforms various database admin tasks. The current task is "creating databases". The script successfully creates the database(s), but when I got to generating the config file for PHP developers it blows up.
I believe it is an issue with referencing and dereferencing variables, but I'm not quite sure what exactly is happening. I think after this function call, something happens to
$$result{'databaseName'}. This is how I get result: $result = $select->fetchrow_hashref()
Here is my function call, and the function implementation:
Function call (line 127):
generateConfig($$result{'databaseName'}, $newPassword, "php");
Function implementation:
sub generateConfig {
my($inName) = $_[0];
my($inPass) = $_[1];
my($inExt) = $_[2];
my($goodData) = 1;
my($select) = $dbh->prepare("SELECT id FROM $databasesTableName WHERE name = '$inName'");
my($path) = $documentRoot.$inName."_config.".$inExt;
$select->execute();
if ($select->rows < 1 ) {
$goodData = 0;
}
while ( $result = $select->fetchrow_hashref() )
{
my($insert) = $dbh->do("INSERT INTO $configTableName(databaseId, username, password, path)".
"VALUES('$$result{'id'}', '$inName', '$inPass', '$path')");
}
return 1;
}
Errors:
Use of uninitialized value in concatenation (.) or string at ./dbcreator.pl line 142.
Use of uninitialized value in concatenation (.) or string at ./dbcreator.pl line 154.
Line 142:
$update = $dbh->do("UPDATE ${tablename}
SET ${jobStatus}='${newStatus}'
WHERE id = '$$result{'id'}'");
Line 154:
print "Successfully created $$result{'databaseName'}\n";
The reason I think the problem comes from the function call is because if I comment out the function call, everything works great!
If anyone could help me understand what's going on, that would be great.
Thanks,
p.s. If you notice a security issue with the whole storing passwords as plain text in a database, that's going to be addressed after this is working correctly. =P
Dylan
You do not want to store a reference to the $result returned from fetchrow_hashref, as each subsequent call will overwrite that reference.
That's ok, you're not using the reference when you are calling generate_config, as you are passing data in by value.
Are you using the same $result variable in generate_config and in the calling function? You should be using your own 'my $result' in generate_config.
while ( my $result = $select->fetchrow_hashref() )
# ^^ #add my
That's all that can be said with the current snippets of code you've included.
Some cleanup:
When calling generate_config you are passing by value, not by reference. This is fine.
you are getting an undef warning, this means you are running with 'use strict;'. Good!
create lexical $result within the function, via my.
While $$hashr{key} is valid code, $hashr->{key} is preferred.
you're using dbh->prepare, might as well use placeholders.
sub generateConfig {
my($inName, inPass, $inExt) = #_;
my $goodData = 1;
my $select = $dbh->prepare("SELECT id FROM $databasesTableName WHERE name = ?");
my $insert = $dbh->prepare("
INSERT INTO $configTableName(
databaseID
,username
,password
,path)
VALUES( ?, ?, ?, ?)" );
my $path = $documentRoot . $inName . "_config." . $inExt;
$select->execute( $inName );
if ($select->rows < 1 ) {
$goodData = 0;
}
while ( my $result = $select->fetchrow_hashref() )
{
insert->execute( $result->{id}, $inName, $inPass, $path );
}
return 1;
}
EDIT: after reading your comment
I think that both errors have to do with your using $$result. If $result is the return value of fetchrow_hashref, like in:
$result = $select->fetchrow_hashref()
then the correct way to refer to its values should be:
print "Successfully created " . $result{'databaseName'} . "\n";
and:
$update = $dbh->do("UPDATE ${tablename}
SET ${jobStatus}='${newStatus}'
WHERE id = '$result{'id'}'");
OLD ANSWER:
In function generateConfig, you can pass a reference in using this syntax:
generateConfig(\$result{'databaseName'},$newPassword, "php");
($$ is used to dereference a reference to a string; \ gives you a reference to the object it is applied to).
Then, in the print statement itself, I would try:
print "Successfully created $result->{'databaseName'}->{columnName}\n";
indeed, fetchrow_hashref returns a hash (not a string).
This should fix one problem.
Furthermore, you are using the variable named $dbh but you don't show where it is set. Is it a global variable so that you can use it in generateConfig? Has it been initialized when generateConfig is executed?
This was driving me crazy when I was running hetchrow_hashref from Oracle result set.
Turened out the column names are always returned in upper case.
So once I started referencing the colum in upper case, problem went away:
insert->execute( $result->{ID}, $inName, $inPass, $path );