Perl DBM::Deep - add/delete in an arrayref of hashrefs - perl

I've been working with DBM::Deep and so far, it's been easy to Read and Update the keys in the DB but when it comes to adding or deleting entities it gets a little complicated and I can't see how it could be done.
I've imported an XML file with XML::Hash and then copied on a DBM::Deep object. So the result is somehow complicated ... The objective of course is to be able to recreate the XML file easily.
So this code:
use DBM::Deep;
use List::Util qw(first);
use Data::Dumper;
my $db = DBM::Deep->new('foo.db');
my $devices = $db->{foo}->{devices}->{device};
(my $match) = grep { $_->{hostname} eq 'myfoo' } #$devices;
print Dumper ($match);
print Dumper($devices);
Gives the following output for the first print:
$VAR1 = bless( {
'enable' => '0',
'hostname' => 'myfoo',
'auth' => 'myauth',
'ip' => 'myip',
'protocol' => 'ssh'
}, 'DBM::Deep::Hash' );
The second print shows:
$VAR1 = bless( [
bless( {
'enable' => '0',
'hostname' => 'myfoo',
'auth' => 'myauth',
'ip' => 'myip',
'protocol' => 'ssh'
}, 'DBM::Deep::Hash' ),
bless( {
'ip' => 'myotherip',
'hostname' => 'myotherfoo',
'auth' => 'myauth',
'protocol' => 'telnet'
}, 'DBM::Deep::Hash' ),
and so on.
Can someone please help me to understand how to Create and Delete in this data structure?

Related

Perl : parse a file and grab blocks

impossible to parse the file below and grab the blocks in an hash table or simple tab.
I would like to have an hash table with for example
[serv-test] => parent=PRODUCTION.Windows,host=1.1.1.1
Problem is I can delimit the start of a block (with /\[.*\]/) but impossible to delimit the end. The end of my blocks is the start of another.
My file:
authreq=false
default.secured=false
port=3181
protocol=TCP
seclevel=2
secured=false
[serv-test]
parent=PRODUCTION.Windows
host=1.1.1.1
[citrix]
parent=PRODUCTION.Windows
host=1.1.1.2
[cluster-serv]
parent=PRODUCTION.Unix._INFRA
host=1.1.1.3
port=3182
Instead of worrying about getting a hash, be satisfied with getting the data. If you give the top a section name, you have an INI File:
[Default]
authreq=false
default.secured=false
port=3181
protocol=TCP
seclevel=2
secured=false
[serv-test]
parent=PRODUCTION.Windows
host=1.1.1.1
[citrix]
parent=PRODUCTION.Windows
host=1.1.1.2
[cluster-serv]
parent=PRODUCTION.Unix._INFRA
host=1.1.1.3
port=3182
Now you can use Config::IniFiles:
use v5.10;
use Config::IniFiles;
my $cfg = Config::IniFiles->new(
-file => "test.ini"
) or die "#Config::IniFiles::errors";
say "Port is ", $cfg->val( 'Default', 'port' );
say "Cluster host is ", $cfg->val( 'cluster-serv', 'host' );
If you really want the hash, that's not so hard:
use Config::IniFiles;
use Data::Dumper;
my $cfg = Config::IniFiles->new(
-file => "test.ini"
) or die "#Config::IniFiles::errors";
my %hash;
foreach my $section ( $cfg->Sections ) {
foreach my $parameter ( $cfg->Parameters( $section ) ) {
$hash{$section}{$parameter} = $cfg->val( $section, $parameter );
}
}
say Dumper \%hash;
Now you have:
$VAR1 = {
'citrix' => {
'parent' => 'PRODUCTION.Windows',
'host' => '1.1.1.2'
},
'Default' => {
'secured' => 'false',
'port' => '3181',
'protocol' => 'TCP',
'default.secured' => 'false',
'authreq' => 'false',
'seclevel' => '2'
},
'serv-test' => {
'host' => '1.1.1.1',
'parent' => 'PRODUCTION.Windows'
},
'cluster-serv' => {
'port' => '3182',
'parent' => 'PRODUCTION.Unix._INFRA',
'host' => '1.1.1.3'
}
};
Don't reinvent the wheel. There are plenty of existing modules for working with INI-style files, including Config::Tiny, Config::INI, and Config::IniFiles, just to name a few.

How can I update a hash value using a hash reference in Perl?

Is there a way to update a value in a hash using a hash reference that points to the hash value?
My hash output looks like this:
'Alternate' => {
'free' => '27.52',
'primary' => 'false',
'used' => '0.01',
'name' => '/mydir/journal2',
'size' => '50.00'
},
'Primary' => {
'free' => '60.57',
'primary' => 'true',
'used' => '0.06',
'name' => '/mydir/journal',
'size' => '64.00'
}
};
I attempted to create a hash reference to the 'used' property in the hash and tried to update the value:
$hash_ref = \%hash->{"Primary"}->{used};
$hash_ref = "99%";
print $$hash_ref, "\n";
This changes the value of the hash, but I get the "Using a hash as a reference is deprecated at line X". I'd like to know if what I'm trying to do is possible and what I'm doing wrong.
...
'Primary' => {
'free' => '60.57',
'primary' => 'true',
'used' => '0.06',
'name' => '/mydir/journal',
'size' => '64.00'
}
...
Try to bypass the deprecation problem doing it like this:
...
my $hash_ref = $hash{'Primary'}; # if you declared `%hash = ( .. );`
# Or my $hash_ref = $hash->{'Primary'}; if you declared `$hash = { .. };`
print $hash_ref->{used}; # Prints 0.06
$hash_ref->{used} = '0.07'; # Update
print $href->{used}; # Prints 0.07
...
See perldsc, if you want to learn more.
Your failure started because you tried to create a hash reference to a scalar. That's kind of a meaningless goal as those are different data types. As Filippo already demonstrated, you already have hash references as values of your greater hash, so you can rely on that.
However, if you really want to create a reference to the scalar, you can just edit that value. This is how you'd do it:
use strict;
use warnings;
my $h = {
'Alternate' => {
'free' => '27.52',
'primary' => 'false',
'used' => '0.01',
'name' => '/mydir/journal2',
'size' => '50.00',
},
'Primary' => {
'free' => '60.57',
'primary' => 'true',
'used' => '0.06',
'name' => '/mydir/journal',
'size' => '64.00',
}
};
my $primary = $h->{Primary};
print $primary->{used}, "\n"; # Outputs 0.06
my $usedref = \$h->{Primary}{used};
$$usedref = '0.07';
print $primary->{used}, "\n"; # Outputs 0.07

mapping hardcoded config files

I have searched for modules to read config files such as Config, Config::Tiny, Config::Simple. I am not too vague about using those, are there any modules for storing/reading dbi config and usernames/passwords? I have attempted to do this myself, I am wanting to have the config file in a hash data structure for easy importing into my module. Is their an easier way to do what I am attempting or a preferred module that could be suggested?
Example config file:
[database]
db=newsdb
host=example.com
user=test
pass=test
[login]
user=john
pass=doe
Coding:
use strict;
use warnings;
use File::Slurp;
use Data::Dumper;
# get database info
my %conf =
map { /^\[database/ ? () : $_ }
grep { /^\w+.*$/ }
map { s/\s?\n?\r?//g; (split /=/)[0,1] } read_file('database.conf');
print Dumper \%conf;
$VAR1 = {
'pass' => 'test',
'db' => 'newsdb',
'user' => 'test',
'host' => 'example.com'
};
The Config module is not used to read configuration files, it gives detailed information on the configuration of your perl instead.
An easy route here would be to use Config::Simple, and then
Config::Simple->import_from("database.conf" => \my %config);
print Dumper \%config;
Output:
$VAR1 = {
'database.host' => 'example.com',
'login.pass' => 'doe',
'login.user' => 'john',
'database.user' => 'test',
'database.db' => 'newsdb',
'database.pass' => 'test'
};
Alternatively, to access just one block, we could do
my $config = Config::Simple->new("database.conf")->get_block("database");
print Dumper $config;
which would give
$VAR1 = {
'pass' => 'test',
'db' => 'newsdb',
'user' => 'test',
'host' => 'example.com'
};
as output. Read the documentation for more information.
It gets even simpler with Config::Tiny:
my $config = Config::Tiny->read("database.conf");
print Dumper $config;
would give
$VAR1 = bless( {
'database' => {
'pass' => 'test',
'db' => 'newsdb',
'user' => 'test',
'host' => 'example.com'
},
'login' => {
'pass' => 'doe',
'user' => 'john'
}
}, 'Config::Tiny' );
so the database portion could be selected with
print Dumper $config->{database}
which would output
$VAR1 = {
'pass' => 'test',
'db' => 'newsdb',
'user' => 'test',
'host' => 'example.com'
};
You can learn more in the documentation.

How do I access values in the data structure returned by XML::Simple?

Hi everyone,
This is very simple for perl programmers but not beginners like me,
I have one xml file and I processed using XML::Simple like this
my $file="service.xml";
my $xml = new XML::Simple;
my $data = $xml->XMLin("$file", ForceArray => ['Service','SystemReaction',
'Customers', 'Suppliers','SW','HW'],);
Dumping out $data, it looks like this:
$data = {
'Service' => [{
'Suppliers' => [{
'SW' => [
{'Path' => '/work/service.xml', 'Service' => 'b7a'},
{'Path' => '/work/service1.xml', 'Service' => 'b7b'},
{'Path' => '/work/service2.xml', 'Service' => 'b5'}]}
],
'Id' => 'SKRM',
'Customers' =>
[{'SW' => [{'Path' => '/work/service.xml', 'Service' => 'ASOC'}]}],
'Des' => 'Control the current through the pipe',
'Name' => ' Control unit'
},
{
'Suppliers' => [{
'HW' => [{
'Type' => 'W',
'Path' => '/work/hardware.xml',
'Nr' => '18',
'Service' => '1'
},
{
'Type' => 'B',
'Path' => '/work/hardware.xml',
'Nr' => '7',
'Service' => '1'
},
{
'Type' => 'k',
'Path' => '/work/hardware.xml',
'Nr' => '1',
'Service' => '1'
}]}
],
'Id' => 'ADTM',
'Customers' =>
[{'SW' => [{'Path' => '/work/service.xml', 'Service' => 'SDCR'}]}],
'Des' => 'It delivers actual motor speed',
'Name' => ' Motor Drivers and Diognostics'
},
# etc.
],
'Systemreaction' => [
# etc.
],
};
How to access each elements in the service and systemReaction(not provided). because I am using "$data" in further processing. So I need to access each Id,customers, suppliers values in each service. How to get particular value from service to do some process with that value.for example I need to get all Id values form service and create nodes for each id values.
To get Type and Nr value I tried like this
foreach my $service (#{ $data->{Service}[1]{Suppliers}[0]{HW}[0] }) {
say $service->{Nr};
}
foreach my $service (#{ $data->{Service}[1]{Suppliers}[0]{HW}[0] }) {
say $service->{Type};
}
can you help me how to get all Nr and Type values from Supplier->HW.
I suggest reading perldocs Reference Tutorial and References and Nested Data Structures. They contain an introduction and full explanation of how to access data like that.
But, for example, you can access the service ID by doing:
say $data->{Service}[0]{Id} # prints SKRM
You could go through all the services, printing their ID, with a loop:
foreach my $service (#{ $data->{Service} }) {
say $service->{Id};
}
In response to your edit
$data->{Service}[1]{Suppliers}[0]{HW}[0] is an hash reference (you can check this quickly by either using Data::Dumper or Data::Dump on it, or just the ref function). In particular, it is { Nr => 18, Path => "/work/hardware.xml", Service => 1, Type => "W" }
In other words, you've almost got it—you just went one level too deep. It should be:
foreach my $service (#{ $data->{Service}[1]{Suppliers}[0]{HW} }) {
say $service->{Nr};
}
Note the lack of the final [0] that you had.

perl - setting up conditions to find correct key in a hash

Problem:
Seeing exists argument is not a HASH or ARRAY element
Need help setting up several conditions to grab the right key.
Code: (I'm not sure also if my conditions are set up correctly. Need advice troubleshooting)
my $xml = qx(#cmdargs);
my $data = XMLin($xml);
my $size=0;
# checking for error string, if file not found then just exit
# otherwise check the hash keys for filename and get its file size
if (exists $data->{class} =~ /FileNotFound/) {
print "The directory: $Path does not exist\n";
exit;
} elsif (exists $data->{file}->{path}
and $data->{file}->{path} =~/test-out-XXXXX/) {
$size=$data->{file}->{size};
print "FILE SIZE:$size\n";
} else {
# print "Nothing to print.\n";
}
# print "$data";
print Dumper( $data );
My Data:
Data structure for xml file with FileNotFound:
$VAR1 = {
'file' => {},
'path' => '/source/feeds/customer/testA',
'class' => 'java.io.FileNotFoundException',
'message' => '/source/feeds/customer/testA: No such file or directory.'
};
Data structure for xml file found:
$VAR1 = {
'recursive' => 'no',
'version' => '0.20.202.1.1101050227',
'time' => '2011-09-30T02:49:39+0000',
'filter' => '.*',
'file' => {
'owner' => 'test_act',
'replication' => '3',
'blocksize' => '134217728',
'permission' => '-rw-------',
'path' => '/source/feeds/customer/test/test-out-00000',
'modified' => '2011-09-30T02:48:41+0000',
'size' => '135860644',
'group' => '',
'accesstime' => '2011-09-30T02:48:41+0000'
},
The interpreter is probably thinking you meant:
exists($data->{class}=~/FileNotFound/)
Try:
exists $data->{class} and $data->{class}=~/FileNotFound/
instead.