I have this code which works.
#!/usr/bin/perl
use warnings;
use strict;
use Net::LDAP;
use Data::Dumper;
my $dn="...";
my $password="...";
my $ldap = Net::LDAP->new('...') or die "$#";
my $mesg = $ldap->bind($dn, password => $password);
if ($mesg->code) { die "uuuu $mesg"; }
$mesg = $ldap->search(
base => "...",
scope => 'one',
filter => '(groupType=-2147483646)',
attrs => ['sAMAccountName'],
);
my #ad = ( );
foreach ($mesg->entries) {
push #ad, $_->asn->{attributes}[0]->{vals}[0];
}
foreach (#ad) {
print;
print "\n";
}
and outputs the name of the security groups.
So I was wondering, if LDAP (Active Directory) have functions to extract the values from the tree rather than having to do hardcode the path using arrays and hashes like I do in
push #ad, $_->asn->{attributes}[0]->{vals}[0];
The tree looks like this
'entries' => [
bless( {
'changes' => [],
'changetype' => 'modify',
'asn' => {
'objectName' => '...',
'attributes' => [
{
'type' => 'sAMAccountName',
'vals' => [
'test-group-1'
]
}
]
}
}, 'Net::LDAP::Entry' ),
bless( {
'changes' => [],
'changetype' => 'modify',
'asn' => {
'objectName' => '...',
'attributes' => [
{
'type' => 'sAMAccountName',
'vals' => [
'test-group-3'
]
}
]
}
}, 'Net::LDAP::Entry' )
],
push #ad, $_->get_value('sAMAccountName');
Related
I have some data in hashref format. I fetch data from graph.facebook.com
How to loop access?
$var = \{
'data' => [
{
'id' => '312351465029_10154168935475030',
'name' => 'Timeline Photos 1'
},
{
'name' => 'Bangchak\'s cover photo',
'id' => '312351465029_10154168087455030',
},
{
'id' => '312351465029_10154168081875030',
'name' => 'Timeline Photos 2',
}
],
'paging' => {
'previous' => 'https://graph.facebook.com/v2.6/312351465029/2',
'next' => 'https://graph.facebook.com/v2.6/312351465029/3'
}
};
These code Didn't work.
foreach $m ($var->{data})
{
if ( $m->{name} =~ /Timeline/i )
{
print "id = $m->{id}\n";
}
}
You need to dereference the array (perldoc perldsc):
use warnings;
use strict;
my $var = {
'data' => [
{
'id' => '312351465029_10154168935475030',
'name' => 'Timeline Photos 1'
},
{
'name' => 'Bangchak\'s cover photo',
'id' => '312351465029_10154168087455030',
},
{
'id' => '312351465029_10154168081875030',
'name' => 'Timeline Photos 2',
}
],
'paging' => {
'previous' => 'https://graph.facebook.com/v2.6/312351465029/2',
'next' => 'https://graph.facebook.com/v2.6/312351465029/3'
}
};
foreach my $m (#{ $var->{data} }) {
if ( $m->{name} =~ /Timeline/i )
{
print "id = $m->{id}\n";
}
}
__END__
id = 312351465029_10154168935475030
id = 312351465029_10154168081875030
I have an array of hashes. Each element in the array is a node in a hierarchical tree and has referential data for who the parent is. I will have thousands and hundreds of thousands of nodes in the tree... essentially an unknown set of nodes has to be converted to JSON (shown below) for use with http://bl.ocks.org/robschmuecker/7880033
UPDATE: position_id is a node in the heretical tree. placement_id is the parent's position_id (adjacency referential tree).
UPDATE: Here's the full AoH Data::Dumper result with Nested Set and Adjacency result from a modified version of DBIx::Tree::NestedSet (custom).
$VAR1 = [
{
'lft' => '673',
'id' => '109',
'date_created' => '2015-08-15',
'level' => '7',
'user_id' => '13',
'placement_id' => '11',
'position_id' => '13',
'status' => '1',
'structure_id' => '1',
'rght' => '684'
},
{
'placement_id' => '13',
'position_id' => '22',
'status' => '1',
'structure_id' => '1',
'rght' => '679',
'lft' => '674',
'date_created' => '2015-08-15',
'id' => '116',
'level' => '8',
'user_id' => '22'
},
{
'user_id' => '101',
'level' => '9',
'id' => '200',
'date_created' => '2015-08-15',
'lft' => '675',
'rght' => '676',
'structure_id' => '1',
'status' => '1',
'position_id' => '101',
'placement_id' => '22'
},
{
'date_created' => '2015-08-15',
'id' => '201',
'level' => '9',
'user_id' => '374',
'lft' => '677',
'structure_id' => '1',
'rght' => '678',
'placement_id' => '22',
'position_id' => '374',
'status' => '1'
},
{
'lft' => '680',
'user_id' => '95',
'level' => '8',
'id' => '117',
'date_created' => '2015-08-15',
'status' => '1',
'position_id' => '95',
'placement_id' => '13',
'rght' => '681',
'structure_id' => '1'
}
];
THIS IS THE GOAL, For this example I need to end up with:
{
"name": "13",
"children": [
{
"name": "22",
"children": [
{
"name": "101"
},
{
"name": "374"
}
]
},
{
"name": "95"
}
]
}
You can also see the format I am trying to arrive at here (minus size):
http://bl.ocks.org/robschmuecker/7880033#flare.json
My failed approach(es) included various attempts at looping through the array of hashes to create a recursive Hash of Hashes that can then be used with the JSON Perl module to create the actual JSON I need.
my $data = [
{ position_id => 123, placement_id => undef },
{ position_id => 456, placement_id => 123 },
{ position_id => 789, placement_id => 123 },
# ...
];
my $roots;
{
my %recs_by_name;
my %children_by_parent_name;
for my $row (#$data) {
my $name = $row->{position_id};
my $parent_name = $row->{placement_id};
my $rec = {
name => $name,
};
push #{ $children_by_parent_name{$parent_name // 'root'} }, $rec;
$recs_by_name{$name} = $rec;
}
$roots = delete($children_by_parent_name{root}) || [];
for my $name (keys(%children_by_parent_name)) {
my $children = $children_by_parent_name{$name};
if ( my $rec = $recs_by_name{$name} ) {
$rec->{children} = $children;
} else {
die("Parent $name doesn't exist.\n");
push #$roots, #$children;
}
}
}
print(Dumper($roots));
Tested.
You appear to have the depth of each node available to you (level). Simpler code could be used if your data was sorted by increasing depths.
While it was #ikegami who ultimately answered the question that led to the solution. I believe the following adaptation adds 4 important elements/clarifications I found helpful, and thought others reading this question and answer would also find useful.
1- Clear addition of all key,value pairs from the originating AoH to the resulting HOH. See while loop.
2- A Child node counter.
3- Inclusion and use of the encode_json function from JSON
4- The result is also an Array with a Hash as the first element. Newbies (like me) might find the explicit #{$roots}[0] passed to encode_json as helpful.
At first I had a similar adapted solution posted as an UPDATE within my question, but was admonished that it was bad etiquette and instructed to post an answer.
#ikegami's deserves the credit for the core of the solution.
sub get_jsonTree {
my ($array_of_hashes_ref) = #_;
my $roots;
my %recs_by_name;
my %children_by_parent_name;
my %count;
for my $row (#$array_of_hashes_ref) {
my $name = $row->{position_id};
my $parent_name = $row->{placement_id};
my $rec = {
name => $name,
};
## Added to loop through all key,value pairs and add them to $rec
while ( my ($key, $value) = each(%$row) ) {
$rec->{$key} = $value;
}
##Added To Count Child Nodes
$count{$parent_name} = 0 if (!$count{$parent_name});
$rec->{'child_count'} = $count{$parent_name};
$count{$parent_name}++;
push #{ $children_by_parent_name{$parent_name // 'root'} }, $rec;
$recs_by_name{$name} = $rec;
}
$roots = delete($children_by_parent_name{root}) || [];
for my $name (keys(%children_by_parent_name)) {
my $children = $children_by_parent_name{$name};
if ( my $rec = $recs_by_name{$name} ) {
$rec->{children} = $children;
} else {
$util{'test'} .= "Parent $name doesn't exist.\n<BR>";
push #$roots, #$children;
}
}
use JSON;
my $json_str = encode_json(#{$roots}[0]);
return $json_str;
}
my $array_of_hashes_ref = [
{ position_id => 123, placement_id => undef },
{ position_id => 456, placement_id => 123 },
{ position_id => 789, placement_id => 123 },
# ...
];
my $json_str = &get_jsonTree($array_of_hashes_ref);
Let's consider this example:
#!/usr/bin/env perl
use strict;
use Data::Dumper;
my $node = node(undef, undef, 'root');
my $root = $node;
$node = node($root, $node, 'tom');
push $root->{children}, $node;
$node = node($root, $node, 'clarence');
push $root->{children}, $node;
Data::Dumper::Purity;
#$root->{children}[0]->{younger} = $root->{children}[1];
print Dumper $root;
sub node {
return {
parent => shift,
prev => shift,
name => shift,
children => [],
};
}
Which gives this output:
$VAR1 = {
'parent' => undef,
'prev' => undef,
'name' => 'root',
'children' => [
{
'parent' => $VAR1,
'prev' => $VAR1,
'name' => 'tom',
'children' => []
},
{
'parent' => $VAR1,
'prev' => $VAR1->{'children'}[0],
'name' => 'clarence',
'children' => []
}
]
};
We can clearly see that root has 2 children named tom and clarence. The reference of clarence on tom is really clear $VAR1->{'children'}[0].
However, if I add a reference on tom to clarence with $root->{children}[0]->{younger} = $root->{children}[1];, the output get messed up:
$VAR1 = {
'parent' => undef,
'prev' => undef,
'name' => 'root',
'children' => [
{
'parent' => $VAR1,
'prev' => $VAR1,
'younger' => {
'parent' => $VAR1,
'prev' => $VAR1->{'children'}[0],
'name' => 'clarence',
'children' => []
},
'name' => 'tom',
'children' => []
},
$VAR1->{'children'}[0]{'younger'}
]
};
Is there any possibility to constraint Data::Dumper or any other dumper to always consider some keys as references in order to properly display a tree?
There isn't a lot you can do because Data::Dumper scans structures depth-first, but I suggest that you use
$Data::Dumper::Deepcopy = 1
which will duplicate hash values in the output instead of inserting cross-references. This is the result
$VAR1 = {
'prev' => undef,
'children' => [
{
'parent' => $VAR1,
'name' => 'tom',
'younger' => {
'children' => [],
'prev' => $VAR1->{'children'}[0],
'name' => 'clarence',
'parent' => $VAR1
},
'prev' => $VAR1,
'children' => []
},
{
'children' => [],
'prev' => {
'parent' => $VAR1,
'name' => 'tom',
'younger' => $VAR1->{'children'}[1],
'prev' => $VAR1,
'children' => []
},
'name' => 'clarence',
'parent' => $VAR1
}
],
'parent' => undef,
'name' => 'root'
};
How do I print all my second level hash keys (sig_qtr, date, range, etc.) given a hash like such:
my $xml = XMLin("./${spec_file}", ForceArray => ['range', 'constant', 'question', 'date', 'sig_yr', 'sig_qtr', 'sig_mth'], KeyAttr => {});
print Dumper $xml->{entities};
print dumper output of hash:
$VAR1 = {
'sig_qtr' => [
{
'name' => 'q1',
'label' => 'q1'
},
{
'name' => 'q4',
'label' => 'q4'
}
],
'date' => [
{
'name' => 'y2_mth',
'label' => 'pryr_mth_curr'
},
{
'name' => 'y3_pod6_qtr4',
'label' => 'curr_qtd4'
}
],
'range' => [
{
'name' => 'y0_jun',
'end' => '20100631',
'start' => '20100601'
},
{
'name' => 'y3_oct',
'end' => '20131031',
'start' => '20131001'
}
],
'constant' => [
{
'spec' => '99999999 and 99999999',
'name' => 'none_sixmth'
}
],
'sig_yr' => [
{
'name' => 'y1_sig',
'label' => 'ye11'
},
{
'name' => 'y3_sig',
'label' => 'ytd'
}
],
'sig_mth' => [
{
'name' => 'y3_nov',
'label' => 'nov12'
},
{
'name' => 'y3_oct',
'label' => 'oct13'
}
],
'question' => [
{
'name' => 'ltrq',
'label' => 'q9'
},
{
'name' => 'nextprod',
'label' => 'q12a'
}
],
'backfill' => {
'label' => 'bf_period'
},
'year' => {
'current' => '2013'
}
};
would be even better if keys are put into an array.
Thanks.
print "$_\n" for keys %{ $xml->entities };
To put them into an array,
my #keys = keys %{ $xml->entities };
When I do
#!/usr/bin/perl -w
use strict;
use Net::LDAP;
use Data::Dumper;
my $dn="...";
my $password="xxx";
my $ldap = Net::LDAP->new('example.com') or die "$#";
my $mesg = $ldap->bind($dn, password => $password);
if ($mesg->code) { die "uuuu $mesg"; }
$mesg = $ldap->search(
base => "dc=example,dc=com",
filter => "(name=LIST)",
);
print Dumper $mesg;
I get
$VAR1 = bless( {
'parent' => bless( {
...
}, 'Net::LDAP' ),
'entries' => [
bless( {
'changes' => [],
'changetype' => 'modify',
'asn' => {
'objectName' => 'CN=LIST,OU=test group,OU=M,OU=I,DC=example,DC=com',
'attributes' => [
{
'type' => 'objectClass',
'vals' => [
'top',
'group'
]
},
{
'type' => 'cn',
'vals' => [
'LIST'
]
},
{
'type' => 'member',
'vals' => [
'CN=user1,OU=BaseUsers,DC=example,DC=com',
'CN=user2,OU=BaseUsers,DC=example,DC=com',
]
},
...
where I would only like to output those from member that have in their object
objectCategory: CN=Person,CN=Schema,CN=Configuration,DC=example,DC=com
Does anyone know how to do that?
foreach my $entry (#{$mesg->{'entries'}})
{
my $match = 0;
my $name = $entry->{'asn'}->{'objectName'};
foreach my $attr (#{$entry->{'asn'}->{'attributes'}})
{
if('member' eq $attr->{'type'})
{
foreach my $val (#{$attr->{'vals'}})
{
if($val =~ /^CN=.*,CN=.*,CN=.*,DC=example,DC=com$/)
{
$match = 1;
last;
}
}
}
}
if($match)
{
print $name;
}
}
For your example data above this will return no matches since none of the "members" match the search pattern you specified. Also I wasn't sure if you wanted to output the object name (as per my code) or the matching string. If the latter you don't need $match, simply put a print in the innermost block.