I want get the values from a hash that uses two keys using a regex just on the second key. This is what I have:
use List::Util qw<first>;
$key1 = "key";
my $value = $hash{$key1}{ ( first { m/teen/ } keys %hash ) || '' };
use warnings;
use strict;
my %hash = ( 'key1' => 'result',
'key2' => 'wrong');
foreach my $key (keys %hash) {
print "$key, $hash{$key}\n" if $hash{$key} =~ /result/;
}
prints:
key1, result
Edit - at a second glance, although I'm still baffled by your code and question, it appears that you want to find a value associated with a particular key, in this case 'key1':
print "key1 = $hash{'key1'}\n";
which prints:
key1 = result
Related
I have list of elements in a hash (%Hash).
I need to compare key elements each other and if one key matches with another key (with certain condition), then it would become a pair and should be stored it in HOA.
Here is my script:
use strict; use warnings;
use Data::Dumper;
my (%A, %Final);
my %Hash = (
'Network=ROOT,Network=R16,Me=4462,Element=1,Node=1,Sec=1,Car=3' => 1,
'Network=ROOT,Network=R16,Me=4462,Element=1,Equipment=1,Rack=1,Slot=1,Unit=1,DeviceSet=1,Device=1' => 1
);
foreach my $car (keys %Hash){
if($car =~ m/Car=\d+/){
if($car =~ /(.*),Node/){
$A{$1} = $car;
}
}
}
print Dumper(\%A);
foreach (keys %Hash){
if($_ =~ m/$A{$_}(.*)(Device=\d+)$/){
push #{$Final{$_}}, $A{$_};
}
}
print "Final:\n".Dumper(\%Final);
Let's say in example, if any element contains Network=ROOT,Network=R16,Me=4462,Element=1 then if any other element contains above data as well as key ends with Device=\d+ then the both should become a key and array of values.
Current result:
$VAR1 = {
'Network=ROOT,Network=R16,Me=4462,Element=1,Equipment=1,Rack=1,Slot=1,Unit=1,DeviceSet=1,Device=1' => [
undef
]
};
Expected Result:
$VAR1 = {
'Network=ROOT,Network=R16,Me=4462,Element=1,Equipment=1,Rack=1,Slot=1,Unit=1,DeviceSet=1,Device=1' => [
Network=ROOT,Network=R16,Me=4462,Element=1,Node=1,Sec=1,Car=3
]
};
Why I am getting undef value in the HOA.
Update:
I have updated the code, in the second hash iteration the code looks like this:
foreach my $ele (keys %Hash){
foreach my $s_c(keys %A){
if($ele =~ m/$s_c(.*)(Device=\d+)$/){
push #{$Final{$ele}}, $A{$s_c};
}
}
}
I am able to get the desired result now. But is there any compact way to achieve this (since I am iterating hash within a hash).
You can use maps to shorten your code. Here is the solution.
#!/usr/bin/perl
use strict; use warnings;
use Data::Dumper;
my (%A, %Final);
my %Hash = (
'Network=ROOT,Network=R16,Me=4462,Element=1,Node=1,Sec=1,Car=3' => 1,
'Network=ROOT,Network=R16,Me=4462,Element=1,Equipment=1,Rack=1,Slot=1,Unit=1,DeviceSet=1,Device=1' => 1
);
map {
$A{$1} = $_ if $_ =~ m/Car=\d+/ && $_ =~ /(.*),Node/
} keys %Hash;
print Dumper(\%A);
map {
my $ele = $_;
map {
my $s_c = $_;
push #{$Final{$ele}}, $A{$s_c} if $ele =~ m/$s_c.*Device=\d+$/;
} keys %A;
} keys %Hash;
print "Final:\n".Dumper(\%Final);
I have code in a loop similar to
for( my $i=0; $a =~ s/<tag>(.*?)<\/tag>/sprintf("&CITE%03d;",$i)/e ; $i++ ){
%cite{ $i } = $1;
}
but instead of just the integer index, I want to make the keys of the hash the actual replaced-with text (placeholder "&CITE001;", etc.) without having to redo the sprintf().
I was almost sure there was a way to do it (variable similar to $& and such, but maybe I was thinking of vim's substitutions and not perl. :)
Thanks!
my $i = 0;
s{<tag>(.*?)</tag>}{
my $entity = sprintf("&CITE%03d;", $i++);
$cite{$entity} = $1;
$entity
}eg;
I did a something of a hacque, but really wanted something a bit more elegant. What I ended up doing (for now) is
my $t;
for( my $i=0; $t = sprintf("&CITE%04d;",$i), $all =~ s/($oct.*?$cct)/$t/s; $i++ ){
$cites{$t} = $1;
}
but I really wanted something even more "self-contained".
Just being able to grab the replacement string would've made things much simpler, though. This is a simple read-modify-write op.
True, adding the 'g' modifier should help shave some microseconds off it. :D
I think any method other than re-starting the search from the start of the target
is always the better choice.
In that vein and, as an alternative, you can move the logic inside the regex
via a Code Construct (?{ code }) and leverage the fact that $^N contains
the last capture content.
Perl
use strict;
use warnings;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
my $target = "<tag>zero</tag>\n<tag>one</tag>\n<tag>two</tag>\n<tag>three</tag>";
my %cite;
my ($cnt,$key) = (0,'');
$target =~ s/
<tag> (.*?) <\/tag>
(?{
$key = sprintf("&CITE%03d;", $cnt++);
$cite{$key} = $^N;
})
/$key/xg;
print $target, "\n";
print Dumper(\%cite);
Output
&CITE000;
&CITE001;
&CITE002;
&CITE003;
$VAR1 = {
'&CITE000;' => 'zero',
'&CITE001;' => 'one',
'&CITE002;' => 'two',
'&CITE003;' => 'three'
};
Edited/code by #Ikegami
use strict;
use warnings;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
sub f {
my $target = "<tag>zero</tag>\n<tag>one</tag>\n<tag>two</tag>\n<tag>three</tag>";
my %cite;
my ($cnt,$key) = (0,'');
$target =~ s/
<tag> (.*?) <\/tag>
(?{
$key = sprintf("&CITE%03d;", $cnt++);
$cite{$key} = $^N;
})
/$key/xg;
print $target, "\n";
print Dumper(\%cite);
}
f() for 1..2;
Output
Variable "$key" will not stay shared at (re_eval 1) line 2.
Variable "$cnt" will not stay shared at (re_eval 1) line 2.
Variable "%cite" will not stay shared at (re_eval 1) line 3.
&CITE000;
&CITE001;
&CITE002;
&CITE003;
$VAR1 = {
'&CITE000;' => 'zero',
'&CITE001;' => 'one',
'&CITE002;' => 'two',
'&CITE003;' => 'three'
};
$VAR1 = {};
This issue has been addressed in 5.18.
Perl by #sln
See, now I don't get that issue in version 5.20.
And, I don't believe I got it in 5.12 either.
use strict;
use warnings;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
sub wrapper {
my ($targ, $href) = #_;
my ($cnt, $key) = (0,'');
$$targ =~ s/<tag>(.*?)<\/tag>(?{ $key = sprintf("&CITE%03d;", $cnt++); $href->{$key} = $^N; })/$key/g;
}
my ($target,%cite) = ("<tag>zero</tag>\n<tag>one</tag>\n<tag>two</tag>\n<tag>three</tag>", ());
wrapper( \$target, \%cite );
print $target, "\n";
print Dumper(\%cite);
($target,%cite) = ("<tag>zero</tag>\n<tag>one</tag>\n<tag>two</tag>\n<tag>three</tag>", ());
wrapper( \$target, \%cite );
print $target, "\n";
print Dumper(\%cite);
Output
&CITE000;
&CITE001;
&CITE002;
&CITE003;
$VAR1 = {
'&CITE000;' => 'zero',
'&CITE001;' => 'one',
'&CITE002;' => 'two',
'&CITE003;' => 'three'
};
&CITE000;
&CITE001;
&CITE002;
&CITE003;
$VAR1 = {
'&CITE000;' => 'zero',
'&CITE001;' => 'one',
'&CITE002;' => 'two',
'&CITE003;' => 'three'
};
Hi I have an perl hash of arbitrary depth. I want to substitute the a string in entire structure with something else.
What is the right approach to do it?
I did something like this
#convert the hash to string for manipulation
my $data = YAML::Dump(%hash);
# do manipulation
---
---
# time to get back the hash
%hash = YAML::Load($data);
Your idea seems very risky to me, since it can be hard to be sure that the substitution won't destroy something in the output of YAML::Dump that will prevent the result from being read back in again, or worse, something that will alter the structure of the hash as it is represented in the dump string. What if the manipulation you are trying to perform is to replace : with , or ’ with ', or something of that sort?
I would probably do something more like this:
use Scalar::Util 'reftype';
# replace $this with $that in key names and string values of $hash
# recursively apply replacement in hash and all its subhashes
sub hash_replace {
my ($hash, $this, $that) = #_;
for my $k (keys %$hash) {
# substitution in value
my $v = $hash->{$k};
if (ref $v && reftype($v) eq "HASH") {
hash_replace($v, $this, $that);
} elsif (! ref $v) {
$v =~ s/$this/$that/og;
}
my $new_hash = {};
for my $k (keys %$hash) {
# substitution in key
(my $new_key = $k) =~ s/$this/$that/og;
$new_hash->{$new_key} = $hash->{$k};
}
%$hash = %$new_hash; # replace old keys with new keys
}
The s/…/…/ replacement I used here may not be appropriate for your task; you should feel free to use something else. For example, instead of strings $this and $that you might pass two functions, $key_change and $val_change which are applied to keys and to values, respectively, returning the modified versions. See the ###### lines below:
use Scalar::Util 'reftype';
# replace $this with $that in key names and string values of $hash
# recursively apply replacement in hash and all its subhashes
sub hash_replace {
my ($hash, $key_change, $val_change) = #_;
for my $k (keys %$hash) {
# substitution in value
my $v = $hash->{$k};
if (ref $v && reftype($v) eq "HASH") {
hash_replace($v, $key_change, $val_change);
} elsif (! ref $v) {
$v = $val_change->($v); #######
}
}
my $new_hash = {};
for my $k (keys %$hash) {
# substitution in key
my $new_key = $key_change->($k); #######
$new_hash->{$new_key} = $hash->{$k};
}
%$hash = %$new_hash;
}
Here's one way to attack it, by recursing through the hash. In this code, you pass in a sub that does whatever you like to each value in the nested hash. This code only modifies the values, not the keys, and it ignores other reference types (ie. scalar refs, array refs) in the nested structure.
#!/usr/bin/perl -w
use Modern::Perl;
## Visit all nodes in a nested hash. Bare-bones.
sub visit_hash
{
my ($start, $sub) = #_;
my #q = ( $start );
while (#q) {
my $hash = pop #q;
foreach my $key ( keys %{$hash} ) {
my $ref = ref($hash->{$key});
if ( $ref eq "" ) { # not a reference
&$sub( $hash->{$key} );
next;
}
if ( $ref eq "HASH" ) { # reference to a nested hash
push #q, $hash->{$key};
next;
}
# ignore other reference types.
}
}
}
The following gives an example of how to use it, replacing e with E in a nested hash:
# Example of replacing a string in all values:
my %hash =
(
a => "fred",
b => "barney",
c => "wilma",
d => "betty",
nest1 =>
{
1 => "red",
2 => "orange",
3 => "green"
},
nest2 =>
{
x => "alpha",
y => "beta",
z => "gamma"
},
);
use YAML::XS;
print "Before:\n";
print Dump( \%hash );
# now replace 'e' with 'E' in all values.
visit_hash( \%hash, sub { $_[0] =~ s/e/E/g; } );
print "After:\n";
print Dump( \%hash );
I need to filter a hash based on a regex, deleting the keys from the hash if the regex matches.
This is what i got so far, unfortunately it doesnt do anything and i have no clue why.
So, i am building the regex out of an array of strings, i need to match substrings as well, so if the hash key is someprefix_somestring i need to match it against somestring or string
my $hashref = {someprefix_somekey => 'somevalue', otherprefix_otherkey => 23, otherprefix_somekey => 'someothervalue'};
my #array_of_strings = ('somekey', 'strings', 'bits', 'bobs');
my $regex = join( '|', sort { length( $b ) <=> length( $a ) or $a cmp $b } #array_of_strings );
$regex = qr{($regex)};
delete $hashref->{ grep { !m/$regex/ } keys %$hashref };
I would expect $hashref to look like this afterwards: {otherprefix_otherkey => 23} since someprefix_somekey and otherprefix_somekey would have matched $regex and would therefore be deleted from the hash
I have no clue why this is not working, please enlighten me
Thanks to hobbs answer i was able to make it work, this is what i have now:
my $hashref = {someprefix_somekey => 'somevalue', otherprefix_otherkey => 23, otherprefix_somekey => 'someothervalue'};
my #array_of_strings = ('somekey', 'strings', 'bits', 'bobs');
my $regex = join( '|', sort { length( $b ) <=> length( $a ) or $a cmp $b } #array_of_strings );
$regex = qr{($regex)};
delete #{$hashref}{grep { m/$regex/ } keys %$hashref };
Your delete isn't quite right because you're using the notation to access a single key, therefore the grep is run in scalar context. Which means that ultimately you're trying to do something like delete $hashref->{'3'} if there are three keys not matching your regex.
If you change your last line to this it should work:
delete #{$hashref}{grep /$regex/, keys %$hashref };
which uses a hash slice. If you think that syntax is too ugly, you could also
delete $hashref->{$_} for grep /$regex/, keys %$hashref;
which might read a little bit more naturally.
I have a hash named %coins.
I am to trying to modify the value of the hash if the key of the hash matches with some string.
I tried the following code, but couldn't succeed. It is creating new key instead of modifying the existing key's value.
Please help
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
my %coins;
%coins = ( "abc" , 1,
"mno pqr" , 2,
"xyz", 3 );
print Dumper \%coins;
if(grep {/mno/} keys %coins)
{
print"matched \n";
$coins{$_} = s/$coins{$_}/new_val/g;
}
print Dumper \%coins;
One way:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
my %coins;
%coins = ( "abc" , 1,
"mno pqr" , 2,
"xyz", 3 );
print Dumper \%coins;
my $newval=9;
foreach my $k (keys%coins){
$coins{$k}=$1.$newval.$2 if ($k =~/(.*)mno(.*)/);
}
For starters, change
if(grep {/mno/} keys %coins)
{
...
}
to
for(grep {/mno/} keys %coins)
{
...
}
As for the value, you want to
( my $new_val = $_ ) =~ s/mno/new_value/g;
$coins{$_} = $new_val;
or
$coins{$_} = $_ =~ s/mno/new_value/gr; # Perl 5.14+