Perl - Convert array to tree OR why variable changes arbitrarily - arrays

I am trying to convert following structure in perl (even elements are "parents" and odd are "childrens"):
$VAR1 = 'ng1';
$VAR2 = [
'ng1_1',
'ng1_2',
'ng1_3',
'ng1_4'
];
$VAR3 = 'ng2';
$VAR4 = [
'ng2_1',
'ng2_2',
'ng2_3',
'ng2_4'
];
$VAR5 = 'ng3';
$VAR6 = [
'ng3_1',
'ng3_2',
'ng3_3',
'ng3_4'
];
$VAR7 = 'ng1_1';
$VAR8 = [
'ng1_1_1',
'ng1_1_2',
'ng1_1_3',
'ng1_1_4'
];
$VAR9 = 'ng1_1_1';
$VAR10 = [
'ng1_1_1_u1',
'ng1_1_1_u2',
'ng1_1_1_u3'
];
$VAR11 = 'ng2_1';
$VAR12 = [
'ng2_1_u1',
'ng2_1_u2',
'ng2_1_u3'
];
to tree structure which will looks like this:
$VAR1 = 'ng1';
$VAR2 = [
'ng1_1',
[
'ng1_1_1',
[
'ng1_1_1_u1',
'ng1_1_1_u2',
'ng1_1_1_u3'
],
'ng1_1_2',
'ng1_1_3',
'ng1_1_4'
],
'ng1_2',
'ng1_3',
'ng1_4'
];
$VAR3 = 'ng2';
$VAR4 = [
'ng2_1',
[
'ng2_1_u1',
'ng2_1_u2',
'ng2_1_u3'
],
'ng2_2',
'ng2_3',
'ng2_4'
];
$VAR3 = 'ng3';
$VAR4 = [
'ng3_1',
'ng3_2',
'ng3_3',
'ng3_4'
];
But after "for loop" I noticed that #arr has changed for unknown reasons, to this:
$VAR1 = 'ng1';
$VAR2 = [
'ng1_1',
[
'ng1_1_1',
[
'ng1_1_1_u1',
'ng1_1_1_u2',
'ng1_1_1_u3'
],
'ng1_1_2',
'ng1_1_3',
'ng1_1_4'
],
'ng1_2',
'ng1_3',
'ng1_4'
];
$VAR3 = 'ng2';
$VAR4 = [
'ng2_1',
'ng2_2',
'ng2_3',
'ng2_4'
];
$VAR5 = 'ng3';
$VAR6 = [
'ng3_1',
'ng3_2',
'ng3_3',
'ng3_4'
];
$VAR7 = 'ng1_1';
$VAR8 = $VAR2->[1];
$VAR9 = 'ng1_1_1';
$VAR10 = $VAR2->[1][1];
$VAR11 = 'ng2_1';
$VAR12 = [
'ng2_1_u1',
'ng2_1_u2',
'ng2_1_u3'
];
Can somebody please explain me why is this happening? Code which I am using for this is following (there is only one for loop for debug purposes). Maybe this is not optimal code, any recommendations are welcomed.
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
my #arr = (
'ng1', ['ng1_1','ng1_2', 'ng1_3', 'ng1_4'],
'ng2', ['ng2_1','ng2_2', 'ng2_3', 'ng2_4'],
'ng3', ['ng3_1','ng3_2', 'ng3_3', 'ng3_4'],
'ng1_1', ['ng1_1_1','ng1_1_2', 'ng1_1_3', 'ng1_1_4'],
'ng1_1_1', ['ng1_1_1_u1', 'ng1_1_1_u2', 'ng1_1_1_u3'],
'ng2_1', ['ng2_1_u1', 'ng2_1_u2', 'ng2_1_u3']
);
my #tree;
#print "\nBEFORE CALLING FIRST FOR LOOP\n";
#print Dumper #arr;
$tree[0] = $arr[0];
$tree[1] = $arr[1];
for (my $i=2; $i < #arr; $i+=2){
&buildTree(\#tree, $arr[$i], $arr[$i+1]);
}
#print "\nAFTER CALLING FIRST FOR LOOP\n";
#print Dumper #arr;
#$tree[2] = $arr[2];
#$tree[3] = $arr[3];
#for (my $i=4; $i < #arr; $i+=2){
# &buildTree(\#tree, $arr[$i], $arr[$i+1]);
#}
sub buildTree{
my ($tree, $parNg, $subNg) = #_;
for my $treeElement (#{$tree}){
if (ref $treeElement eq "ARRAY"){
&buildTree($treeElement, $parNg, $subNg);
}
else{
if ($treeElement eq $parNg){
my ($index) = grep { $tree->[$_] eq $treeElement } 0..scalar(#$tree)-1;
splice #{$tree}, $index + 1, 0, $subNg;
}
}
}
}
Thank you

Hash is a better structure for trees as the node names cannot be duplicate.
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
my %tree = (
ng1 => ['ng1_1' , 'ng1_2' , 'ng1_3' , 'ng1_4' ],
ng2 => ['ng2_1' , 'ng2_2' , 'ng2_3' , 'ng2_4' ],
ng3 => ['ng3_1' , 'ng3_2' , 'ng3_3' , 'ng3_4' ],
ng1_1 => ['ng1_1_1' , 'ng1_1_2' , 'ng1_1_3' , 'ng1_1_4'],
ng1_1_1 => ['ng1_1_1_u1' , 'ng1_1_1_u2', 'ng1_1_1_u3' ],
ng2_1 => ['ng2_1_u1' , 'ng2_1_u2' , 'ng2_1_u3' ],
);
my $change = 1;
while ($change) {
undef $change;
for my $remove (keys %tree) {
my #nonleaves = grep exists $tree{$_}, #{ $tree{$remove} };
if (not #nonleaves) {
my ($parent) = grep { grep $_ eq $remove, #{ $tree{$_} } } keys %tree;
next unless $parent;
$_ eq $remove and $_ = { $remove => $tree{$remove} } for #{ $tree{$parent} };
delete $tree{$remove};
$change = 1;
}
}
}
print Dumper \%tree;
Output:
$VAR1 = {
'ng1' => [
{
'ng1_1' => [
{
'ng1_1_1' => [
'ng1_1_1_u1',
'ng1_1_1_u2',
'ng1_1_1_u3'
]
},
'ng1_1_2',
'ng1_1_3',
'ng1_1_4'
]
},
'ng1_2',
'ng1_3',
'ng1_4'
],
'ng3' => [
'ng3_1',
'ng3_2',
'ng3_3',
'ng3_4'
],
'ng2' => [
{
'ng2_1' => [
'ng2_1_u1',
'ng2_1_u2',
'ng2_1_u3'
]
},
'ng2_2',
'ng2_3',
'ng2_4'
]
};

Related

Issue creating JSON feed in Laravel

I am trying to create a JSON feed using two arrays of data in the format mentioned below.
{
"items":[
{
"category_id":1,
"category_name":"Mens Clothing",
"child":[
{
"product_id":1,
"product_name":"Shirts"
},
{
"product_id":2,
"product_name":"T-Shirts"
}
]
}
]
}
However, I am getting like the following.
{
"items":[
{
"category_id":1,
"category_name":"Mens Clothing",
"child":[
]
}
],
"child":[
{
"product_id":1,
"product_name":"Shirts"
},
{
"product_id":2,
"product_name":"T-Shirts"
}
]
}
I have written the following in Laravel.
$data = [
'items' => [],
];
foreach ($categories as $key => $category) {
$data['items'][$key] = [
'category_id' => $category->id,
'category_name' => $category->category_name,
'child' => [],
];
}
foreach ($products as $key => $product) {
$data['child'][$key] = [
'product_id' => $product->id,
'product_name' => $product->product_name
];
}
Can anyone please help me figure out this issue?
If product has 'category_id' - something like the following can work:
$data = [
'items' => [],
];
foreach ($categories as $key => $category) {
$children = [];
foreach ($products as $key => $product){
if($product->category_id == $category->id) {
$children[] = $product;
}
}
$data['items'][$key] = [
'category_id' => $category->id,
'category_name'=> $category->category_name,
'child' => $children,
];
}

How do I parse an array in perl that contains subarrays?

Let me preface by saying I'm a total novice at perl.
I need to modify rules on a mail system. I can access the rules as an array and I believe the array contains subarrays. I need to modify one particular element and preserve the rest. My problem is I'm confused as to what the array type really is and how to consistently access the elements.
There may be more than one set of rules, but I'm only interested in processing rules with a priority of '1', which is $Rule[0]. Within $Rule[3] I need to parse the addresses.
use strict;
use Data::Dumper qw(Dumper);
my $Rules=$cli->GetAccountMailRules($account);
print Dumper \#$Rules;
foreach my $Rule (#$Rules) {
if($Rule->[0]=~/1/) {
my $pri=$Rule->[0];
my $type=$Rule->[1];
my $auto=$Rule->[2];
my $actions=$Rule->[3];
my $action1;
my $auto1;
my $auto2;
my #newRule;
my $oldDest;
print "\n";
print "Priority:\n";
print Dumper \$pri;
print "\n";
print "Rule Type:\n";
print Dumper \$type;
print "\n";
print "Forward Auto?:\n";
print Dumper \$auto;
print "\n";
print "Actions:\n";
print Dumper \$actions;
print "\n";
foreach my $ax (#$actions) {
$action1=$ax->[0];
$oldDest=$ax->[1];
}
my #addresses=split /[;,]|\\e/, $oldDest;
my #dests = grep(/corp.com|corp1.com|corp2.com|corp3.com/, #addresses);
my $newDest = join(",", #dests);
if (#$auto) {
foreach my $au (#$auto) {
$auto1=$au->[0];
$auto2=$au->[1];
}
#newRule=(
[ $pri, $type,
[[$auto1,$auto2]],
[[$action1,$newDest]]
]
);
} else {
#newRule=(
[ $pri, $type,
[],
[[$action1,$newDest]]
]
);
}
}
}
}
Output thusly:
# perl removeRules.pl
$VAR1 = [
[
'1',
'#Redirect',
[
[
'Human Generated',
'---'
]
],
[
[
'Mirror to',
'test10#corp.com\\etest10#gmail.com\\etest10#corp1.com'
]
]
]
];
Priority:
$VAR1 = \'1';
Rule Type:
$VAR1 = \'#Redirect';
Forward Auto?:
$VAR1 = \[
[
'Human Generated',
'---'
]
];
Actions:
$VAR1 = \[
[
'Mirror to',
'test10#corp.com\\etest10#gmail.com\\etest10#corp1.com'
]
];
The problem I'm running into is there is an option within $actions to discard emails after forwarding, which introduces new elements (or subarray?) into $actions:
# perl removeRules.pl
$VAR1 = [
[
'1',
'#Redirect',
[
[
'Human Generated',
'---'
]
],
[
[
'Mirror to',
'test10#corp.com\\etest10#gmail.com\\etest10#corp1.com'
],
[ <---- Begin new elements
'Discard',
'---'
] <---- End new elements
]
]
];
Priority:
$VAR1 = \'1';
Rule Type:
$VAR1 = \'#Redirect';
Forward Auto?:
$VAR1 = \[
[
'Human Generated',
'---'
]
];
Actions:
$VAR1 = \[
[
'Mirror to',
'test10#corp.com\\etest10#gmail.com\\etest10#corp1.com'
],
[
'Discard',
'---'
]
];
I tried testing to see if they can be referenced as additional elements in $actions but it throws off the index.
my $action2;
my $action3;
print "Actions:\n";
print Dumper \$actions;
print "\n";
foreach my $ax (#$actions) {
$action1=$ax->[0];
$oldDest=$ax->[1];
$action2=$ax->[2];
$action3=$ax->[3];
}
print " action1 $action1\n";
print " oldDest $oldDest\n";
print " action2 $action2\n";
print " action3 $action3\n";
Output:
Actions:
$VAR1 = \[
[
'Mirror to',
'test10#corp.com\\etest10#gmail.com\\etest10#corp1.com'
],
[
'Discard',
'---'
]
];
action1 Discard
oldDest ---
Use of uninitialized value $action2 in concatenation (.) or string at removeRules.pl line 107, <GEN0> line 4.
action2
Use of uninitialized value $action3 in concatenation (.) or string at removeRules.pl line 108, <GEN0> line 4.
action3
Thank you in advance.
Using this:
[
[
'Mirror to',
'test10#corp.com\\etest10#gmail.com\\etest10#corp1.com'
],
[
'Discard',
'---'
]
]
This is a reference to an array (the outer [..]) that has two items. Each item is again a reference to an array.
First item (position 0 of outer array reference) is
[
'Mirror to',
'test10#corp.com\\etest10#gmail.com\\etest10#corp1.com'
],
and second (position 1) is:
[
'Discard',
'---'
]
If $ractions is this outer array, then the above two items are respectively under $ractions->[0] and $ractions->[1].
Since they are both an array reference again you can access their items using the same construct, or using a Perl property, you can remove the second array.
In short:
'Mirror to' can be accessed by $ractions->[0]->[0] or shorter $ractions->[0][0]
'test10#corp.com\etest10#gmail.com\etest10#corp1.com' can be accessed by $ractions->[0]->[1]
'Discard' can be accessed by $ractions->[1]->[0]
'---' can be accessed by $ractions->[1]->[1]
Be aware however that $VAR1 = \[ shows that you have a reference over a reference. So you will need an extra step of derefencing:
DB<1> use Data::Dumper;
DB<2> #a=(1,2)
DB<3> print Data::Dumper::Dumper(#a);
$VAR1 = 1;
$VAR2 = 2;
DB<4> print Data::Dumper::Dumper(\#a);
$VAR1 = [
1,
2
];
DB<5> print Data::Dumper::Dumper(\\#a);
$VAR1 = \[
1,
2
];
PS: do not use corp.com or anything like that when you need to obfuscate domain names. See guidance in RFC2606 or TL;DR: use example.com

Using join to concatenate array values

I have array values that is getting returned from SQL object.
my #keys = $db_obj->SelectAllArrayRef($sql);
print Dumper #keys;
gives
$VAR1 = [ [ '8853' ], [ '15141' ] ];
I need to create string from this array: 8853, 15141.
my $inVal = join(',', map { $_->[0] }, #$keys);
my $inVal;
foreach my $result (#$keys){
$inVal .= $result->[0];
}
my $inVal = join(',', #$keys);
Value i get is ARRAY(0x5265498),ARRAY(0x52654e0). I think its reference to the array. Any idea what am I missing here?
Don't pass arrays to Dumper; it leads to confusing output. $VAR1 is not a dump of #keys, it's a dump of $keys[0]. Instead, you should have done
print(Dumper(\#keys));
This would have given
$VAR1 = [ [ [ '8853' ], [ '15141' ] ] ];
The code you want is
join ',', map { $_->[0] }, #{ $keys[0] };
That said, it appears that ->SelectAllArrayRef returns a reference to the result, and so it should be called as follows:
my $keys = $db_obj->SelectAllArrayRef($sql);
For this,
print(Dumper($keys));
outputs
$VAR1 = [ [ '8853' ], [ '15141' ] ];
And you may use either of the methods you used in your question.
join ',', map { $_->[0] }, #$keys;
The first version should work for you:
my $arr = [ [ '8853' ], [ '15141' ] ];
my $values = join(',', map { $_->[0] } #$arr);
print $values . "\n";
8853,15141

How can I delete duplicate values across arrays stored in hash?

I have the following hash:
my %HASH = (
'List1' => [ 'the', 'red', 'cat', 'jumps' ],
'List2' => [ 'the', 'brown', 'fox', 'jumps' ],
'List3' => [ 'a', 'red', 'fox', 'jumps' ],
);
I want to delete duplicate elements across these arrays, so that only unique elements remain. The desired output would be the following:
my %HASH = (
'List1' => [ 'cat' ],
'List2' => [ 'brown' ],
'List3' => [ 'a' ],
);
In other words, if an element is present in both List1 and List2, it should be deleted from both lists.
I have tried to do the following:
use strict;
use warnings;
use diagnostics;
use Data::Dumper;
foreach my $key ( keys %HASH ) {
foreach ( #{$HASH{$key}} ) {
if(exists($HASH{$key})){
#{$HASH{$key}} = delete($HASH{$key});
}
}
}
print Dumper(\%HASH);
Which doesn't seem to do anything, the hash remains the way it was. I'm still pretty new to Perl, so I'm not sure where I went wrong with that. But Perldoc says that calling exists on array values is deprecated anyway, so any solution which uses something other than exists is welcome too!
use strict;
use warnings;
my %hash = (
'List1' => [ 'the', 'red', 'cat', 'jumps' ],
'List2' => [ 'the', 'brown', 'fox', 'jumps' ],
'List3' => [ 'a', 'red', 'fox', 'jumps' ],
);
# first, we count all words
my %count;
for my $words (values %hash) {
for my $word (#$words) {
$count{$word}++;
}
}
# Now, we filter the words with `grep` so that only
# those remain which were found once
for my $words (values %hash) {
#$words = grep { $count{$_} == 1 } #$words;
}
use Data::Dump;
dd \%hash;
Outputs:
{ List1 => ["cat"], List2 => ["brown"], List3 => ["a"] }

perl array of hashes using Tie::IxHash

I am trying to create an array of hashes with each has being an tied, ordered IxHash. When looping through my initial hash, the keys are indeed in order. However, as soon as I push them onto an array, the ordering disappears. I know this is my poor knowledge of what is happening with the hash when it is pushed on the array, but if somebody could enlighten me, it would be much appreciated.
#! /usr/bin/perl -w
use strict;
use Data::Dumper;
use Tie::IxHash;
my #portinfo;
tie (my %portconfig, 'Tie::IxHash',
'name' => [ 'Name', 'whatever' ],
'port' => [ 'Port', '12345' ],
'secure' => [ 'Secure', 'N' ]
);
print "Dump of hash\n";
print Dumper(%portconfig);
print "\nDump of array\n";
push #portinfo, {%portconfig};
print Dumper(#portinfo);
The output of this :-
Dump of hash
$VAR1 = 'name';
$VAR2 = [
'Name',
'whatever'
];
$VAR3 = 'port';
$VAR4 = [
'Port',
'12345'
];
$VAR5 = 'secure';
$VAR6 = [
'Secure',
'N'
];
Dump of array
$VAR1 = {
'secure' => [
'Secure',
'N'
],
'name' => [
'Name',
'whatever'
],
'port' => [
'Port',
'12345'
]
};
Your code:
push #portinfo, {%portconfig};
print Dumper(#portinfo);
takes the tied hash %portconfig and places its contents into a new anonymous hash which is then pushed into #portinfo. Thus, you have an anonymous, non-ordered hash in your array.
What you probably mean to do is
push #portinfo, \%portconfig;
print Dumper(#portinfo);
This pushes a reference to %portconfig into #portinfo, thereby retaining your required ordering.
Thus:
#! /usr/bin/perl -w
use strict;
use Data::Dumper;
use Tie::IxHash;
my #portinfo;
tie (my %portconfig, 'Tie::IxHash',
'name' => [ 'Name', 'whatever' ],
'port' => [ 'Port', '12345' ],
'secure' => [ 'Secure', 'N' ]
);
print "Dump of hash\n";
print Dumper(%portconfig);
print "\nDump of array\n";
push #portinfo, \%portconfig;
print Dumper(#portinfo);
Gives
C:\demos>perl demo.pl
Dump of hash
$VAR1 = 'name';
$VAR2 = [
'Name',
'whatever'
];
$VAR3 = 'port';
$VAR4 = [
'Port',
'12345'
];
$VAR5 = 'secure';
$VAR6 = [
'Secure',
'N'
];
Dump of array
$VAR1 = {
'name' => [
'Name',
'whatever'
],
'port' => [
'Port',
'12345'
],
'secure' => [
'Secure',
'N'
]
};

Resources