Greetings I need to generate a xml document from a nested perl hash, keeping the order of the hash keys. I am trying out https://metacpan.org/pod/Tie::IxHash
for the keeping the keys in order part.
However I cannot figure out how to access the hash keys that Tie::IxHash creates, they dont behave like a hash key, hash ref key or an object.
In the sample code I create a Tie::IxHash and try to print the key Transmitter
Here is the sample code:
use strict;
use warnings;
use diagnostics;
use Scalar::Util;
use Data::Dumper;
use XML::Writer;
use Tie::IxHash;
use DateTime::Format::XSD;
my $time = time;
my $dt = DateTime->now;
my $timestamp = DateTime::Format::XSD->format_datetime($dt);
my $transmissionId = sprintf("%u",int(rand(100000000000000000000))). "E";
#sample data structure as hsah ref
# my $transmissionHeader = {
# TransmissionId => "$transmissionId",
# Timestamp => "$timestamp",
# Transmitter => {
# ETIN => '1232456789',
# SOME => '5555555555',
# }
# };
my $transmissionHeader = Tie::IxHash->new(
TransmissionId => "$transmissionId",
Timestamp => "$timestamp",
Transmitter => Tie::IxHash->new( #each nested hash a new object?
ETIN => '1232456789',
SOME => '5555555555',
),
);
print Dumper $transmissionHeader;
# tried all these no joy
print "$transmissionHeader{Transmitter} \n";
print "$transmissionHeader->{Transmitter} \n";
print "$transmissionHeader->Transmitter() \n";
You can use the Indices() method to get the index of the key, and then use the Values() method to get the value of that key:
my $idx = $transmissionHeader->Indices('Transmitter');
my $hash = $transmissionHeader->Values($idx);
print Dumper $hash;
Related
I have a hash %defines_3 which looks like this
'PIOMUX2_UART_3_TXD' => 'CONFIG_PIO31_6_SELECTOR',
'PIOMUX_UART_1_TXD' => 'CONFIG_PIO22_7_SELECTOR',
'PIOMUX_UART_11_TXD' => 'CONFIG_PIO0_4_SELECTOR',
'PIOMUX_UART_10_TXD' => 'CONFIG_PIO0_1_SELECTOR',
'PIOMUX2_UART_1_TXD' => 'CONFIG_PIO25_2_SELECTOR',
'PIOMUX_UART_3_TXD' => 'CONFIG_PIO32_6_SELECTOR',
To change some parts from all keys and values I did like this :
for (values %defines_3)
{
s/CONFIG_/PIO_M_U_/g;
s/_SELECTOR//g;
}
for (keys %defines_3)
{
s/_TXD//g;
}
print Dumper \%defines_3;
after which I am getting this :
'PIOMUX2_UART_3_TXD' => 'PIO_M_U_PIO31_6',
'PIOMUX_UART_1_TXD' => 'PIO_M_U_PIO22_7',
'PIOMUX_UART_11_TXD' => 'PIO_M_U_PIO0_4',
'PIOMUX_UART_10_TXD' => 'PIO_M_U_PIO0_1',
'PIOMUX2_UART_1_TXD' => 'PIO_M_U_PIO25_2',
'PIOMUX_UART_3_TXD' => 'PIO_M_U_PIO32_6',
So basically I am not able to substitute the keys but the values are being substituted the way i want by using s/ . How to change keys?
values() are producing lvalues which are due foreach aliased to $_ and thus can be directly changed. keys() must be deleted from hash in order to be changed,
for (keys %defines_3) {
my $v = delete $defines_3{$_};
s/_TXD//g;
$defines_3{$_} = $v;
}
or for newer perl which has support for /r switch,
for (keys %defines_3) {
$defines_3{ s/_TXD//gr } = delete $defines_3{$_};
}
You can't rename hash keys, as they are stored as simple C strings and not Perl scalar variables. To achieve the same effect you can delete the hash element and reinsert it using a new key.
Usefully, the delete operator returns the hash element's value, so you could write it like this.
Note that it is normally unwise to modify a hash or an array while you are iterating over it, but it is safe in this instance because the keys %data expression returns a fixed list of all of the hash keys that is separate from the hash itself.
use strict;
use warnings;
my %data = (
PIOMUX2_UART_3_TXD => 'CONFIG_PIO31_6_SELECTOR',
PIOMUX_UART_1_TXD => 'CONFIG_PIO22_7_SELECTOR',
PIOMUX_UART_11_TXD => 'CONFIG_PIO0_4_SELECTOR',
PIOMUX_UART_10_TXD => 'CONFIG_PIO0_1_SELECTOR',
PIOMUX2_UART_1_TXD => 'CONFIG_PIO25_2_SELECTOR',
PIOMUX_UART_3_TXD => 'CONFIG_PIO32_6_SELECTOR',
);
for my $key ( keys %data) {
(my $new_key = $key) =~ s/_TXD$//;
(my $new_val = delete $data{$key}) =~ s/^CONFIG_(.+)_SELECTOR$/PIO_M_U_$1/;
$data{$new_key} = $new_val;
}
use Data::Dump;
dd \%data;
output
{
PIOMUX2_UART_1 => "PIO_M_U_PIO25_2",
PIOMUX2_UART_3 => "PIO_M_U_PIO31_6",
PIOMUX_UART_1 => "PIO_M_U_PIO22_7",
PIOMUX_UART_10 => "PIO_M_U_PIO0_1",
PIOMUX_UART_11 => "PIO_M_U_PIO0_4",
PIOMUX_UART_3 => "PIO_M_U_PIO32_6",
}
This is probably easiest by using the pairmap function from List::Util. Its block is executed once for each key/value pair in the input list, and whatever list of values it returns is collected, like a regular map. This makes it easy to build a new hash out of an old one:
use 5.014; # for the s///r syntax
use List::Util qw( pairmap );
my %new_hash = pairmap {
( $a =~ s/_TXD$//r, $b =~ s/^CONFIG_(.+)_SELECTOR$/PIO_M_U_$1/r )
} %old_hash;
If you're stuck before 5.14 without the s///r syntax, you can do it with
use List::Util qw( pairmap );
my %new_hash = pairmap {
my ( $key, $val ) = ( $a, $b );
$key =~ s/_TXD$//;
$val =~ s/^CONFIG_(.+)_SELECTOR$/PIO_M_U_$1/;
( $key, $val )
} %old_hash;
In this answer I found a recommendation for a simple TO_JSON method, which is needed for serializing blessed objects to JSON.
sub TO_JSON { return { %{ shift() } }; }
Could anybody please explain in detail how it works?
I changed it to:
sub TO_JSON {
my $self = shift; # the object itself – blessed ref
print STDERR Dumper $self;
my %h = %{ $self }; # Somehow unblesses $self. WHY???
print STDERR Dumper \%h; # same as $self, only unblessed
return { %h }; # Returns a hashref that contains a hash.
#return \%h; # Why not this? Works too…
}
Many questions… :( Simply, I’m unable to understand 3-liner Perl code. ;(
I need the TO_JSON but it will filter out:
unwanted attributes and
unset attributes too (e.g. for those the has_${attr} predicate returns false)
This is my code – it works but I really don't understand why the unblessing works…
use 5.010;
use warnings;
use Data::Dumper;
package Some;
use Moo;
has $_ => ( is => 'rw', predicate => 1,) for (qw(a1 a2 nn xx));
sub TO_JSON {
my $self = shift;
my $href;
$href->{$_} = $self->$_ for( grep {!/xx/} keys %$self );
# Same mysterious unblessing. The `keys` automagically filters out
# “unset” attributes without the need of call of the has_${attr}
# predicate… WHY?
return $href;
}
package main;
use JSON;
use Data::Dumper;
my #objs = map { Some->new(a1 => "a1-$_", a2 => "a2-$_", xx=>"xx-$_") } (1..2);
my $data = {arr => \#objs};
#say Dumper $data;
say JSON->new->allow_blessed->convert_blessed->utf8->pretty->encode($data);
EDIT: To clarify the questions:
The %{ $hRef } derefences the $hRef (getting the hash pointed to by the reference), but why get a plain hash from a blessed object reference $self?
In other words, why the $self is a hashref?
I tried to make a hash slice like #{$self}{ grep {!/xx/} keys %$self} but it didn't work. Therefore I created that horrible TO_JSON.
If the $self is a hashref, why the keys %$self returns only attributes having a value, and not all declared attributes (e.g. the nn too – see the has)?
sub TO_JSON { return { %{ shift() } }; }
| | |
| | L_ 1. pull first parameter from `#_`
| | (hashref/blessed or not)
| |
| L____ 2. dereference hash (returns key/value list)
|
L______ 3. return hashref assembled out of list
In your TO_JSON() function { %h } returns a shallow hash copy, while \%h returns a reference to %h (no copying).
Perl implemented object orientation by simply making it possible for a reference to know which package it came from (with bless). Knowing that a reference came from the Foo package means that methods are really functions defined in that package.
Perl allows any kind of reference to get blessed; not just hash references. It's very common to bless hash references; a lot of documentation shows doing exactly that; and Moose does it; but, it's possible to bless an array reference, or a subroutine reference, or a filehandle, or a reference to a scalar. The syntax %{$self} only works on hash references (blessed or not). It takes the hash reference, and dereferences it as a hash. The fact that the original reference may have been blessed is lost.
I need the TO_JSON but what will filter out:
unwanted attributes
and unset attributes too (e.g. for those the has_${attr} predicate returns false.
Pre-5.20, hash slices only give you the values and not the keys from the original hash. You want both keys and values.
Assuming you have a hash, and want to filter out undef values and keys not on a whitelist, there are a few options. Here's what I have, using the JSON module:
use strict; # well, I used "use v5.18", but I don't know which version of Perl you're using
use warnings;
use JSON;
my $foo = { foo => undef, bar => 'baz', quux => 5 };
my %whitelist = map { $_, 1 } qw{foo bar};
my %bar = map { $_ => $foo->{$_} }
grep { defined $foo->{$_} && exists $whitelist{$_} }
keys %$foo;
print to_json(\%bar) . "\n";
# well, I used say() instead of print(), but I don't know which version of Perl you're using
The maps and greps aren't necessarily pretty, but it's the simplest way I could think of to filter out keys not on the whitelist and elements without an undef value.
You could use an array slice:
use strict;
use warnings;
use JSON;
my $foo = { foo => undef, bar => 'baz', quux => 5 };
my #whitelist = qw{foo bar};
my %filtered_on_keys;
#filtered_on_keys{#whitelist} = #$foo{#whitelist};
my %bar = map { $_ => $filtered_on_keys{$_} }
grep { defined $filtered_on_keys{$_} }
keys %filtered_on_keys;
print to_json(\%bar) . "\n";
Or if you like loops:
use strict;
use warnings;
use JSON;
my $foo = { foo => undef, bar => 'baz', quux => 5 };
my %whitelist = map { $_ => 1 } qw{foo bar};
my %bar;
while (my ($key, $value) = each %$foo) {
if (defined $value && exists $whitelist{$key}) {
$bar{$key} = $value;
}
}
print to_json(\%bar) . "\n";
It seems like a good time to bring up Larry wall's quote, "Perl is designed to give you several ways to do anything, so consider picking the most readable one."
However, I made a big point that not all objects are hashes. The appropriate way to get data from an object is through its getter functions:
use strict;
use warnings;
use JSON;
my $foo = Foo->new({ foo => undef, bar => 'baz', quux => 5 }); # as an example
my %filtered_on_keys;
#filtered_on_keys{qw{foo bar}} = ($foo->get_foo(), $foo->get_bar());
my %bar = map { $_ => $filtered_on_keys{$_} }
grep { defined $filtered_on_keys{$_} }
keys %filtered_on_keys;
print to_json(\%bar) . "\n";
I am trying to use Redis::Client::Hash per the instructions, but keep getting
"Can't locate object method "TIEHASH" via package "Redis::Client::Hash" at ./redishasttest.pl line 8."
Here's the code:
#!/usr/bin/perl -w
use strict;
use Redis::Client;
my $client = Redis::Client->new;
tie( my %hash, "Redis::Client::Hash", key => 'hello', client => $client);
my #keys = keys %hash;
$hash{foo} = 42;
print 1 if exists $hash{foo};
Seems straightforward enough -- Perl version 5.10.1, Redis 2.6.14. I am thinking it's a Moose thing or something, as the module has a TIEHASH sub. Redis::Client::Hash is actually installed when you install Redis::Client, so everything there looks good. The same sort of thing happens with Redis::Client::String so can't TIESCALAR. Am I missing something?
After friedo's answer, the solution to check that a hash key is set in redis is:
#!/usr/bin/perl -w
use strict;
use Redis::Client;
use Redis::Client::Hash;
my $key = 'hello';
my $client = Redis::Client->new;
# first make sure hash with key exists
if ($client->type($key) ne "hash") {
print "$key not a hash\n";
$client->hmset($key, dummy => 1);
}
tie( my %hash, "Redis::Client::Hash", key => $key, client => $client);
print "KEY VALUE\n" if %hash > 0;
foreach my $k (keys %hash) {
print "$k $hash{$k}\n";
}
Thanks again for the nice group of modules!
Redis::Client doesn't load the tie modules directly, so you just have to use them first.
use strict;
use Redis::Client;
use Redis::Client::Hash; # <---- add this
my $client = Redis::Client->new;
# first create something
$client->hset( 'hello', some => 'thing' );
tie( my %hash, "Redis::Client::Hash", key => 'hello', client => $client);
my #keys = keys %hash;
$hash{foo} = 42;
print 1 if exists $hash{foo};
It looks like I need to clarify that in the docs. I can probably do a new release this weekend.
use 5.010;
use strict;
use warnings;
use JSON::XS;
use YAML::XS;
my %data = ();
my $content = <<HERE;
{
"name":"BLAHBLAH","contact":{"phone":"12345","twitter":"BLAHBLAH"},
"location": {"address":"NOTTELLING","lat":10,"lng":10,"postalCode":"1234",
"city":"BLAH","state":"BLAH","country":"BLAH"},
"categories":[{"id":"BLAH","name":"BLAH"}]
}
HERE
my $id = "name1";
sub function {
my ( $id, $data, $content ) = #_;
my %data = %$data;
my $out = decode_json($content);
say "out:", Dump $out;
$data{$id} = $out;
}
function( $id, \%data, $content );
say "data:", Dump %data;
This doesn't work as the way I expected. Can you please tell me why and how it will work?
"This doesn't work as the way i expected."
What were you expecting? Let's step through the errors:
1) date != data
2) $content=~m!(,*)! will leave $1 empty, since $content doesn't contain any commas.
3) decode_json($1) will throw a runtime error, since $1 is empty and decode_json() can only be applied to a properly formatted JSON string.
4) $id is not defined.
"Can you please tell me why and how it will work?"
It won't work, if that isn't clear yet. There are more errors than code there.
"how do I assign a hash ref into hash?"
Use the \ unary reference operator, eg:
my %h = ();
my %h2 = (
a => 10
);
$h{h2} = \%h2;
print $h{h2}->{a};
You can also declare a scalar ($) as a reference to an anonymous (unnamed) hash; here $hr is a reference, the hash itself has no symbol or name associated with it:
my $hr = {
n => 42
};
# as an existing hash member:
$h{h3} = {
x => 666,
# some other examples:
hr => \%h2,
hr2 => {
x => 1024
}
};
Notice curly braces {} used in the declaration instead of (). When you are nesting (anonymous) hashes as with hr2, always use that form.
If you search for perl hash tutorial you'll find more in-depth things.
The reason that you're not finding anything in the package-scoped %data (the one defined just after use YAML::XS) is because you're creating a brand-new and completely independent %data inside of function with the line
my %data = %$data;
This creates a new hash and copies the contents of the hash referenced by $data into it.
Try this instead:
sub function {
my ($id, $data, $content) = #_;
my $out = decode_json($content);
say "out:", Dump $out;
$data->{$id} = $out;
}
I think you have a typo:
function($id,/%data,$content);
must be
function($id,\%data,$content);
and $content is not a reference to %data hash, so in your function you should do:
my %data=%$data; # in place of "my %content=%$content;"
I was wondering if you could shed some lights regarding the code I've been doing for a couple of days.
I've been trying to convert a Perl-parsed hash back to XML using the XMLout() and XMLin() method and it has been quite successful with this format.
#!/usr/bin/perl -w
use strict;
# use module
use IO::File;
use XML::Simple;
use XML::Dumper;
use Data::Dumper;
my $dump = new XML::Dumper;
my ( $data, $VAR1 );
Topology:$VAR1 = {
'device' => {
'FOC1047Z2SZ' => {
'ChassisID' => '2009-09',
'Error' => undef,
'Group' => {
'ID' => 'A1',
'Type' => 'Base'
},
'Model' => 'CATALYST',
'Name' => 'CISCO-SW1',
'Neighbor' => {},
'ProbedIP' => 'TEST',
'isDerived' => 0
}
},
'issues' => [
'TEST'
]
};
# create object
my $xml = new XML::Simple (NoAttr=>1,
RootName=>'data',
SuppressEmpty => 'true');
# convert Perl array ref into XML document
$data = $xml->XMLout($VAR1);
#reads an XML file
my $X_out = $xml->XMLin($data);
# access XML data
print Dumper($data);
print "STATUS: $X_out->{issues}\n";
print "CHASSIS ID: $X_out->{device}{ChassisID}\n";
print "GROUP ID: $X_out->{device}{Group}{ID}\n";
print "DEVICE NAME: $X_out->{device}{Name}\n";
print "DEVICE NAME: $X_out->{device}{name}\n";
print "ERROR: $X_out->{device}{error}\n";
I can access all the element in the XML with no problem.
But when I try to create a file that will house the parsed hash, problem arises because I can't seem to access all the XML elements. I guess, I wasn't able to unparse the file with the following code.
#!/usr/bin/perl -w
use strict;
#!/usr/bin/perl
# use module
use IO::File;
use XML::Simple;
use XML::Dumper;
use Data::Dumper;
my $dump = new XML::Dumper;
my ( $data, $VAR1, $line_Holder );
#this is the file that contains the parsed hash
my $saveOut = "C:/parsed_hash.txt";
my $result_Holder = IO::File->new($saveOut, 'r');
while ($line_Holder = $result_Holder->getline){
print $line_Holder;
}
# create object
my $xml = new XML::Simple (NoAttr=>1, RootName=>'data', SuppressEmpty => 'true');
# convert Perl array ref into XML document
$data = $xml->XMLout($line_Holder);
#reads an XML file
my $X_out = $xml->XMLin($data);
# access XML data
print Dumper($data);
print "STATUS: $X_out->{issues}\n";
print "CHASSIS ID: $X_out->{device}{ChassisID}\n";
print "GROUP ID: $X_out->{device}{Group}{ID}\n";
print "DEVICE NAME: $X_out->{device}{Name}\n";
print "DEVICE NAME: $X_out->{device}{name}\n";
print "ERROR: $X_out->{device}{error}\n";
Do you have any idea how I could access the $VAR1 inside the text file?
Regards,
newbee_me
$data = $xml->XMLout($line_Holder);
$line_Holder has only the last line of your file, not the whole file, and not the perl hashref that would result from evaling the file. Try something like this:
my $ref = do $saveOut;
The do function loads and evals a file for you. You may want to do it in separate steps, like:
use File::Slurp "read_file";
my $fileContents = read_file( $saveOut );
my $ref = eval( $fileContents );
You might want to look at the Data::Dump module as a replacement for Data::Dumper; its output is already ready to re-eval back.
Basically to load Dumper data you eval() it:
use strict;
use Data::Dumper;
my $x = {"a" => "b", "c"=>[1,2,3],};
my $q = Dumper($x);
$q =~ s{\A\$VAR\d+\s*=\s*}{};
my $w = eval $q;
print $w->{"a"}, "\n";
The regexp (s{\A\$VAR\d+\s*=\s*}{}) is used to remove $VAR1= from the beginning of string.
On the other hand - if you need a way to store complex data structure, and load it again, it's much better to use Storable module, and it's store() and retrieve() functions.
This has worked for me, for hashes of hashes. Perhaps won't work so well with structures which contain references other structures. But works well enough for simple structures, like arrays, hashes, or hashes of hashes.
open(DATA,">",$file);
print DATA Dumper(\%g_write_hash);
close(DATA);
my %g_read_hash = %{ do $file };
Please use dump module as a replacement for Data::Dumper
You can configure the variable name used in Data::Dumper's output with $Data::Dumper::Varname.
Example
use Data::Dumper
$Data::Dumper::Varname = "foo";
my $string = Dumper($object);
eval($string);
...will create the variable $foo, and should contain the same data as $object.
If your data structure is complicated and you have strange results, you may want to consider Storable's freeze() and thaw() methods.