I have a variable that looks like this:
do {
my $a = {
computers => [
{
report_date_epoch => 1591107993595,
serial_number => "C02YK1TAFVCF",
username => "fake1\#example.com",
},
{
report_date_epoch => 1626877069476,
serial_number => "C03XF8AWJG5H",
username => "fake2\#example.com",
},
...
And I'd like to sort it by the epoch number into a new variable without the computers array.
The list of hashrefs in the arrayref for computer key sorted
use warnings;
use strict;
use feature 'say';
use Data::Dump qw(dd);
my $v = {
computers => [
{
report_date_epoch => 1591107993595,
serial_number => "C02YK1TAFVCF",
username => "fake1\#example.com",
},
{
report_date_epoch => 1626877069476,
serial_number => "C03XF8AWJG5H",
username => "fake2\#example.com",
}
]
};
my #by_epoch =
sort { $a->{report_date_epoch} <=> $b->{report_date_epoch} }
#{$v->{computers}};
dd $_ for #by_epoch;
I use Data::Dump to print complex data structures. (There are other good ones as well.)
Or use a core (installed) tool
use Data::Dumper;
...
say Dumper $_ for #by_epoch;
Sort::Key is so much cleaner than the builtin sort. Not much difference in this instance, but it only gets better as the task becomes more complex.
use Sort::Key qw( ikeysort );
my #by_report_date =
ikeysort { $_->{report_date_epoch} } # Sort them.
#{ $a->{computers} }; # Get the elements of the array of computers.
Related
I'm trying to print the outputs from an API which are in multidimensional format.
use strict;
use warnings;
use Data::Dumper;
my $content={
'school_set' => 'SSET1234',
'result' => [
{
'school_name' => 'school_abc',
'display_value' => 'IL25',
'school_link' => 'example.com',
'status' => 'registerd',
'status_message' => 'only arts',
'school_id' => '58c388d40596191f',
}
],
'school_table' => 'arts_schools'
};
print "school_name is=".$content{result}[0]{school_name};
print "school_status is=".$content{result}[3]{status};
output
Global symbol "%content" requires explicit package name (did you forget to declare "my %content"?) at test8.pl line 20.
Global symbol "%content" requires explicit package name (did you forget to declare "my %content"?) at test8.pl line 21.
I have to print the outputs like below from the result.
school_name = school_abc
school_status = registered
If $content is a hash reference, you need to dereference it first. Use the arrow operator for that:
$content->{result}[0]{school_name}
The syntax without the arrow is only possible for %content.
my %content = ( result => [ { school_name => 'abc' } ] );
print $content{result}[0]{school_name};
If you want to print all the results, you have to loop over the array somehow. For example
#!/usr/bin/perl
use warnings;
use strict;
my $content = {
'result' => [
{
'school_name' => 'school_abc',
'status' => 'registerd',
},
{
'school_name' => 'school_def',
'status' => 'pending',
}
],
};
for my $school (#{ $content->{result} }) {
print "school_name is $school->{school_name}, status is $school->{status}\n";
}
Your data structure assumes an array, perhaps it would be useful to utilize loop output for the data of interest.
The data presented as hash reference and will require de-referencing to loop through an array.
Following code snippet is based on your posted code and demonstrates how desired output can be achieved.
use strict;
use warnings;
use feature 'say';
my $dataset = {
'school_set' => 'SSET1234',
'result' => [
{
'school_name' => 'school_abc',
'display_value' => 'IL25',
'school_link' => 'example.com',
'status' => 'registerd',
'status_message' => 'only arts',
'school_id' => '58c388d40596191f',
}
],
'school_table' => 'arts_schools'
};
for my $item ( #{$dataset->{result}} ) {
say "school_name is = $item->{school_name}\n"
. "school_status is = $item->{status}";
}
exit 0;
Output
school_name is = school_abc
school_status is = registerd
I have an array of states in the format
('AL','Alabama','AK','Alaska','AR','Arkansas'...)
which I want formatted like:
[{'AL' => 'Alabama'},...]
This is primarily so that I can more easily loop through using the HTML::Template module (https://metacpan.org/pod/HTML::Template#TMPL_LOOP)
I'm fairly new to perl, so unsure about how to do this sort of action and can't find something similar enough.
Wouldn't the following make more sense for HTML::Template?
states => [ { id => 'AL', name => 'Alabama' }, ... ]
This would allow you to use the following template:
<TMPL_LOOP NAME=states>
<TMPL_VAR NAME=name> (<TMPL_VAR NAME=id>)
</TMPL_LOOP>
To achieve that, you can use the following:
use List::Util 1.29 qw( pairmap );
states => [ pairmap { +{ id => $a, name => $b } } #states ]
That said, you're probably generating HTML.
<select name="state">
<TMPL_LOOP NAME=states>
<option value="<TMPL_VAR NAME=id_html>"><TMPL_VAR NAME=name_html></option>
</TMPL_LOOP>
</select>
To achieve that, you can use the following:
use List::Util 1.29 qw( pairmap );
{
my %escapes = (
'&' => '&',
'<' => '<',
'>' => '>',
'"' => '"',
"'" => ''',
);
sub text_to_html(_) { $_[0] =~ s/([&<>"'])/$escapes{$1}/rg }
}
states => [ pairmap { +{ id_html => $a, name_html => $b } } map text_to_html, #states ]
use List::Util 1.29;
#state_hashes = List::Util::pairmap { +{ $a => $b } } #states;
Unless you need to keep this hash around for later use I think that simply looping through the elements two at a time would be simpler. You can accomplish this type of looping easily with splice:
my #states = ('AL','Alabama','AK','Alaska','AR','Arkansas'...);
while (my ($code, $name) = splice(#states, 0, 2)) {
# operations here
}
Alternatively, you can use this same approach to create the data structure you want:
my #states = ('AL','Alabama','AK','Alaska','AR','Arkansas'...);
my #state_hashes = ();
while (my ($code, $name) = splice(#states, 0, 2)) {
push #state_hashes, { $code => $name };
}
# do w/e you want with #state_hashes
Note: splice will remove elements from #states
bundle_by from List::UtilsBy can easily create this format:
use strict;
use warnings;
use List::UtilsBy 'bundle_by';
my #states = ('AL', 'Alabama', 'AK', 'Alaska', 'AR', 'Arkansas', ... );
my #hashes = bundle_by { +{#_} } 2, #states;
map solution with a few perlish things
my #states = ('AL','Alabama','AK','Alaska','AR','Arkansas','VT','Vermont');
my %states;
map { $states{$states[$_]} = $states[$_+1] unless $_%2 } 0..$#states;
I have an LDAP directory that I'm querying using Net::LDAP. This gives me a set of parent-child relationships.
It's a directory of people - and includes a 'manager' DN (which is another field within the directory).
I'm having real trouble turning this manager->person set of records into a hierarchical structure.
What I've got so far is:
#!/usr/bin/env perl
use strict;
use warnings;
use Net::LDAP;
use Data::Dumper;
my %people;
my $ldap = Net::LDAP->new('my_ldap_server');
my $result = $ldap->bind('bind_dn');
die if $result->code;
my $search = $ldap->search(
base => 'ou=yaddayadda',
scope => 'subtree',
filter => 'objectClass=person',
attrs => ['manager'],
);
foreach my $found ( $search->entries ) {
my $mgr = $found->get_value('manager');
my $dn = $result->dn;
push( #{ $people{$mgr} }, $dn );
}
What this gives me is a hash of managers and the people who work for them (using DN, which is unique).
An entry from %people looks like:
$VAR1 = {
'cn=Firstname Lastname,ou=OrgUnit' => [
'cn=Personame Lastname,ou=OrgUnit',
'cn=AnotherPerson NameHere,ou=OrgUnit',
],
'cn=AnotherPerson NameHere,ou=OrgUnit' => [
'cn=Someone Else,ou=OrgUnit',
]
};
But I'm having trouble with turning that parent-child mapping into a hierarchical structure.
e.g.:
'ceo' => [
'pa' => [],
'head_of_dept' => [
'person' => [],
'person_with_staff' => [ 'person3', 'person4' ]
]
]
I'm at something of a loss for how to accomplish this. It seems it shouldn't be too hard to do, given that each person is unique within the organisation structure.
NB - in the above, I've got cn=AnotherPerson NameHere,ou=OrgUnit who has a subordinate, and I'm after making a nested mapping out of this:
e.g.:
$VAR1 = {
'cn=Firstname Lastname,ou=OrgUnit' => [
'cn=Personame Lastname,ou=OrgUnit',
'cn=AnotherPerson NameHere,ou=OrgUnit',
[
'cn=Someone Else,ou=OrgUnit'
]
]
};
What you need is a directed graph, and I suggest using the Graph::Directed module, whose methods are documented in Graph
This program will build the graph for you, but without any data I couldn't test it beyond making sure it compiles
use strict;
use warnings 'all';
use feature 'say';
use Net::LDAP;
use Graph::Directed;
use Data::Dumper;
my $ldap = Net::LDAP->new('my_ldap_server');
my $result = $ldap->bind('bind_dn');
die if $result->code;
my $search = $ldap->search(
base => 'ou=yaddayadda',
scope => 'subtree',
filter => 'objectClass=person',
attrs => ['manager'],
);
my $g = Graph::Directed->new;
for my $found ( $search->entries ) {
my $mgr = $found->get_value('manager');
my $dn = $result->dn;
$g->add_edge($mgr, $dn);
}
say $g;
The resulting Graph::Directed object has a stringification overload so you can examine it superficially by simply printing it, but when you want to interrogate the structure further you will need to know some of the terms of graph theory. For instance, $g->source_vertices will return a list of all nodes that have descendants but no parents—in this case, a list of senior management, or $g->is_cyclic will return true if your data has any loops anywhere
Here's an example of a program that uses your brief sample data to display a hierarchical tree of nodes
use strict;
use warnings 'all';
use Graph::Directed;
my $data = {
'cn=Firstname Lastname,ou=OrgUnit' => [
'cn=Personame Lastname,ou=OrgUnit',
'cn=AnotherPerson NameHere,ou=OrgUnit',
],
'cn=AnotherPerson NameHere,ou=OrgUnit' =>
[ 'cn=Someone Else,ou=OrgUnit', ]
};
my $g = Graph::Directed->new;
for my $mgr ( keys %$data ) {
$g->add_edge($mgr, $_) for #{ $data->{$mgr} };
}
dump_tree($_) for $g->source_vertices;
sub dump_tree {
my ($node, $level) = ( #_, 0);
print ' ' x $level, $node, "\n";
dump_tree($_, $level+1) for $g->successors($node);
}
output
cn=Firstname Lastname,ou=OrgUnit
cn=AnotherPerson NameHere,ou=OrgUnit
cn=Someone Else,ou=OrgUnit
cn=Personame Lastname,ou=OrgUnit
#Hunter McMillen unfortunately deleted his very good but slightly off answer. Here is my attempt to augment his code by turning the relationship from underling -> boss towards boss -> underlings.
To simulate the LDAP responses, I created a simple Moose class.
package Person;
use Moose;
has name => ( is => 'ro' );
has boss => ( is => 'ro', predicate => 'has_boss' );
package main;
use strict;
use warnings;
use Data::Printer;
# make a randomized list of people
my %people = map { $_->name => $_ }
map {
Person->new(
name => $_->[0], ( $_->[1] ? ( boss => $_->[1] ) : () )
)
} (
[qw( ceo )], [qw( head_of_dept ceo)],
[qw( person head_of_dept)], [qw( person_with_staff head_of_dept )],
[qw( person3 person_with_staff )], [qw( person4 person_with_staff )],
);
my %manages;
foreach my $p (values %people) {
push #{ $manages{ $p->boss } }, $p->name if $p->has_boss;
}
# this part shamelessly stolen from #HunterMcMillen's deleted answer
sub build_tree {
my ($person) = #_;
my #subtrees;
foreach my $managee ( #{ $manages{$person} } ) {
push #subtrees, build_tree($managee);
}
return { $person => \#subtrees };
}
p build_tree 'ceo';
Here's the output.
\ {
ceo [
[0] {
head_of_dept [
[0] {
person []
},
[1] {
person_with_staff [
[0] {
person4 []
},
[1] {
person3 []
}
]
}
]
}
]
}
This should be more or less what you want.
I have an array with n number of elments. I want to add each of the elements to a complex hash, each as a key/value pair. If the number of elements were fixed, say three, I would do:
my %hash;
my #array = ("first", "second", "third");
$hash{$array[0]}{$array[1]}{$array[2]}++;
The structure I want to end up with, is this (printed with Data::Dumper):
$VAR1 = 'first';
$VAR2 = {
'second' => {
'third' => 1
};
But I am at loss at achieving the same structure when the number of elements in the array isn't fixed. Something with anonymous variables and iterating through the array, yes, but something like foreach #array{$hash{$_}++}; will obviously only make one entry per element, and not the desired structure. Help?
Something like this could build the structure you desire for N elements:
use strict;
use warnings;
use Data::Dumper;
my #array = qw(first second third four five six seven);
my $hash;
foreach my $key ( reverse #array ) {
$hash = { $key => $hash };
}
print Dumper $hash;
__END__
$VAR1 = {
'first' => {
'second' => {
'third' => {
'fourth' => {
'fifth' => {
'sixth' => {
'seventh' => undef
}
}
}
}
}
}
};
It is not clear what you really need this for. There may be a better solution if you explain your use-case a little more. Incrementing this structure doesn't appear to be very easy.
After playing around a little, you can increment by traversing the hash reference to the bottom then incrementing the value of the last element. It is not very pretty though :|
# incrementing
my $elem = $hash; # copy the reference
foreach my $key ( #array ) {
# found the bottom of the hash
unless ( $elem->{$key} && ref($elem->{$key}) ) {
$elem->{$key}++;
last;
}
# not at the bottom, move to the next level
$elem = $elem->{$key};
}
print Dumper $hash;
__END__
$VAR1 = {
'first' => {
'second' => {
'third' => {
'fourth' => {
'fifth' => {
'sixth' => {
'seventh' => 1
}
}
}
}
}
}
};
This is relatively simple if you maintain a current hash reference. This short program demonstrates
The first few steps make sure that each hash element exists and its value is a hash reference. $href is moved to the next level of hash at each stage. For the final element of the array, the latest hash level's element is incremented instead of being set to a hash reference.
Whether or not this data structure is the correct choice depends on what else you need to do with it once you have built it
use strict;
use warnings;
my %hash;
my #array = qw/ first second third fourth fifth /;
drill_hash(\%hash, #array);
use Data::Dump;
dd \%hash;
sub drill_hash {
my ($href, #list) = #_;
my $final = pop #list;
$href = $href->{$_} //= {} for #list;
++$href->{$final};
}
output
{
first => { second => { third => { fourth => { fifth => 1 } } } },
}
Update
Having understood your purpose, the simplest way to keep a count of occurrences of ngrams like that is to have a speficic hash key that is used to keep the count of the sequence of words so far.
This program uses the value _COUNT for that key, and you can see that, for example, {under}{a}{_COUNT} and {under}{a}{rock}{_COUNT} are both 1
use strict;
use warnings;
my %counts;
count_ngram(\%counts, qw/ under a /);
count_ngram(\%counts, qw/ a rock /);
count_ngram(\%counts, qw/ under a rock /);
count_ngram(\%counts, qw/ a tree /);
count_ngram(\%counts, qw/ under a tree /);
use Data::Dump;
dd \%counts;
sub count_ngram {
my ($href, #ngram) = #_;
my $final = pop #ngram;
$href = $href->{$_} //= {} for #ngram;
++$href->{$final}{_COUNT};
}
output
{
a => { rock => { _COUNT => 1 }, tree => { _COUNT => 1 } },
under => {
a => { _COUNT => 1, rock => { _COUNT => 1 }, tree => { _COUNT => 1 } },
},
}
I have this script that use a hash table:
#!/usr/bin/env perl
use strict; use warnings;
my $hash = {
'cat' => {
"félin" => '0.500000',
'chat' => '0.600000',
'chatterie' => '0.300000'
'chien' => '0.01000'
},
'rabbit' => {
'lapin' => '0.600000'
},
'canteen' => {
"ménagère" => '0.400000',
'cantine' => '0.600000'
}
};
my $text = "I love my cat and my rabbit canteen !\n";
foreach my $word (split "\s+", $text) {
print $word;
exists $hash->{$word}
and print "[" . join(";", keys %{ $hash->{$word} }) . "]";
print " ";
}
For now, I have this output:
I love my cat[chat;félin;chatterie;chien] and my rabbit[lapin] canteen[cantine;ménagère] !
I need to have the nbest key value according to the frequencies (stored in my hash). For example, I want to have the 3 best translations according to the frequencies like this:
I love my cat[chat;félin;chatterie] and my rabbit[lapin] canteen[cantine;ménagère] !
How can I change my code to take into account the frequencies of each values and also to print the nbest values ?
Thanks for your help.
The tidiest way to do this is to write a subroutine that returns the N most frequent translations for a given word. I have written best_n in the program below to do that. It uses rev_nsort_by from List::UtilsBy to do the sort succinctly. It isn't a core module, and so may well need to be installed.
I have also used an executable substitution to modify the string in-place.
use utf8;
use strict;
use warnings;
use List::UtilsBy qw/ rev_nsort_by /;
my $hash = {
'cat' => {
'félin' => '0.500000',
'chat' => '0.600000',
'chatterie' => '0.300000',
'chien' => '0.01000',
},
'rabbit' => {
'lapin' => '0.600000',
},
'canteen' => {
'ménagère' => '0.400000',
'cantine' => '0.600000',
}
};
my $text = "I love my cat and my rabbit canteen !\n";
$text =~ s{(\S+)}{
$hash->{$1} ? sprintf '[%s]', join(';', best_n($1, 3)) : $1;
}ge;
print $text;
sub best_n {
my ($word, $n) = #_;
my $item = $hash->{$word};
my #xlate = rev_nsort_by { $item->{$_} } keys %$item;
$n = $n > #xlate ? $#xlate : $n - 1;
#xlate[0..$n];
}
output
I love my [chat;félin;chatterie] and my [lapin] [cantine;ménagère] !