Using map in a void context? - perl

I have this code:
my %events = ();
map { $events{$_} => 1 } #event_ids;
map { $events{$_} => 2 } #teen_event_ids;
map { $events{$_} => 3 } #kids_event_ids;
Although the arrays have data, the content of %events is turning up empty.

%events wasn't changed because you never even tried to change %events (except for emptying it when it was already empty)! I think you meant to do
my %events;
map { $events{$_} = 1 } #event_ids;
map { $events{$_} = 2 } #teen_event_ids;
map { $events{$_} = 3 } #kids_event_ids;
Using map in void context is frowned-upon. The following are more familiar:
my %events = (
( map { $_ => 1 } #event_ids ),
( map { $_ => 2 } #teen_event_ids ),
( map { $_ => 3 } #kids_event_ids ),
);
or
my %events;
$events{$_} = 1 for #event_ids;
$events{$_} = 2 for #teen_event_ids;
$events{$_} = 3 for #kids_event_ids;
Technically, you can use parens around map's operands (map( BLOCK LIST )), but it looks weird, so I put the parens around then entire map.

That's... not really the way map is intended to be used. It transforms a list into a different list and returns the resulting list. It's not meant to change a list (or hash) in-place.
Try this instead:
my %events = ();
$events{$_} = 1 for #event_ids;
$events{$_} = 2 for #teen_event_ids;
$events{$_} = 3 for #kids_event_ids;
or, if you specifically want to include a map:
my %events = map { $_ => 1 } #event_ids;
$events{$_} = 2 for #teen_event_ids;
$events{$_} = 3 for #kids_event_ids;
or even:
my %events = map { $_ => find_event_category($_) } #event_ids, #teen_event_ids, #kids_event_ids;
where find_event_category is a function which determines whether an id is for a teen or kids event and returns 1, 2, or 3 as appropriate.

OK, it's time to get some sleep. Should just be using = not the fat arrow, =>.

Related

How can a attribute (which is a class) access the class to which it is an attribute?

A confusing title, I know. But the code should be clear:
class A {
has $.foo = 1;
# how can I access B::bar from here?
}
class B {
has $.bar = 2;
has A $.a;
submethod TWEAK {
$!a = A.new;
}
}
my $b = B.new;
say $b; # B.new(bar => 2, a => A.new(foo => 1))
say $b.a; # A.new(foo => 1)
my $test := $b.a;
say $test; # A.new(foo => 1)
Given $test, how can I access B::bar (which is on the same "level" as $test)?
Personally if I had to do this I'd state that A can have an attribute parent that fulfils a Role HasBar like so.
role HasBar {
has $.bar = 2;
}
class A {
has $.foo = 1;
has HasBar $.parent;
}
class B does HasBar {
has A $.a;
submethod TWEAK {
$!a = A.new( parent => self );
}
}
Attributes generally don't (and shouldn't) know if they are contained in another object. So if you want to be able to do that you need to tell them the connection exists. I prefer using Roles to do this as then your A class could be an attribute in lots of different things as long as the container has a bar accessible.
You could try this:
class B { ... } #need to decl B before you use it
class A {
has $.foo is rw = 1; #foo is already =1
has B $.b;
} #no TWEAK needed
class B {
has $.bar is rw = 2;
has A $.a;
}
say my $a = A.new(b => B.new);
say my $b = B.new(a => A.new);
say my $a2 = A.new(b => $b);
say my $b2 = B.new(a => $a2);
say $a2.b.bar; #2
say $b2.a.foo; #1
$b2.a.b.a.foo = 42; #added is rw trait to show this
say $b2;
#B.new(bar => 2, a => A.new(foo => 1, b => B.new(bar => 2, a => A.new(foo => 42, b => B))))
If you look at the output you will see that the $b2 is a nested recursion. Not sure if that is what you want! My bet is that #scimon s answer is a better one...

Perl Issue trying to add static text by IP address

I have a script that has an exact count of IP address' being compared to an expected count of IP address going though a specific port.
Code:
my %minimum = (
'10.10.10.10' => 2,
'10.10.10.11' => 3,
'10.10.10.12' => 6,
'10.10.10.13' => 7,
);
my %count;
open my $fh, '-|', 'netstat -an |grep 1111 ' or die "could not run netstat: $!";
while(<$fh>) {
next unless /^\s*............(regex) /;
$count{$1}++;
}
close $fh;
while(my ($ip, $expected) = each %minimum) {
$count{$ip} ||= 0;
next if $count{$ip} == $expected && print color("green"), "$ip: OK! Expected = $expected count = $count{$ip}\n", color("reset");
print color("red"), "$ip: BAD! Expected = $expected count = $count{$ip}\n", color("reset");
}
I'm trying to add a static hostname. Currently an example output looks like:
10.10.10.10: OK! Expected = 2 Actual = 2
10.10.10.11: OK! Expected = 3 Actual = 3
10.10.10.12: OK! Expected = 6 Actual = 6
10.10.10.13: BAD! Expected = 7 Actual = 5
But I want to include a static hostname to look like below:
10.10.10.10: aaaa#aa.com OK! Expected = 2 Actual = 2
10.10.10.11: bbb#aa.com OK! Expected = 3 Actual = 3
10.10.10.12: ccc#aa.com OK! Expected = 6 Actual = 6
10.10.10.13: ddd#aa.com BAD! Expected = 7 Actual = 5
Thank you all for any recommendations/tips.
You could create a second hash to keep the info, keyed on the ip addresses, or you could create a nested data structure like so:
my %minimum = (
'10.10.10.10' => { label => 'hotdog', count => 2 },
'10.10.10.11' => { label => 'burger', count => 3 },
'10.10.10.12' => { label => 'steak', count => 6 },
'10.10.10.13' => { label => 'pizza', count => 7 },
);
and then later, when you need the info, you can retrieve it:
while(my ($ip, $data) = each %minimum) {
$count{$ip} ||= 0;
my $label = $data->{label};
my $expected = $data->{count};
# ... rest of code here ...
}
my %notes = (
'10.10.10.10' => 'cheeseburger',
'10.10.10.11' => 'hotdog',
'10.10.10.12' => '...',
'10.10.10.13' => '...',
);
s{^([^:]*):\K}{ defined($notes{$1}) ? " $notes{$1}" : "" }e;

Hash reference - Reuse inner hash to store and retrieve next values

I am new to Perl programming and have to work on Hash of Hashes. I am trying to reuse innerHash variables to be dynamic in nature. And I expect the inner items to be stored in outerHash how ever many I have added. Below is my test program snippet.
use warnings;
sub testHash {
my %outerHash = ();
my %innerHash1 = ();
my %innerHash2 = ();
$innerHash1{"key1"} = "value1";
$innerHash1{"key2"} = "value2";
$innerHash1{"key3"} = "value3";
$outerHash{"Master1"} = \%innerHash1;
$innerHash2{"key4"} = "value4";
$innerHash2{"key5"} = "value5";
$innerHash2{"key6"} = "value6";
$outerHash{"Master2"} = \%innerHash2;
#delete $innerHash1{$_};
%innerHash1 = ();
#undef %innerHash1;
$innerHash1{"key7"} = "value7";
$innerHash1{"key8"} = "value8";
$innerHash1{"key9"} = "value9";
$outerHash{"Master3"} = \%innerHash1;
foreach $outerItem (keys %outerHash){
print "\n$outerItem: ";
foreach $innerItem (keys %{$outerHash{$outerItem}}){
print "\t $innerItem = $outerHash{$outerItem}{$innerItem}";
}
print "\n-------------------------------------------------------";
}
print "\n";
}
testHash;
Output:
Master3: key8 = value8 key7 = value7 key9 = value9
-----------------------------------------------------------------
Master2: key5 = value5 key6 = value6 key4 = value4
-----------------------------------------------------------------
Master1: key8 = value8 key7 = value7 key9 = value9
-----------------------------------------------------------------
I understand it's taking the newer reference of innerHash1 while printing the items. What is the right way to have all the right elements in outerHash? In a real programming scenario I cannot declare n variables in advance.
You may be new to perl, but you understand the concept of pointers don't you? The code $outerHash{"Master1"} = \%innerHash1; means that "$outerHash{"Master1"} is assigned a pointer to %innerHash1". So what you're observing is correct and expected.
If you want to keep recreating %innerHash and adding it to %outerHash, you will need to do one of two things:
Assign by value. $outerHash{"Master1"} = {}; %{$outerHash{"Master1"}} = %innerHash1;
Only add %innerHash to %outerHash once per loop. Since %innerHash is redeclared within the loop, not outside of it, it goes out of scope every loop, but its contents will be kept in outerHash due to perl's reference counting. Depending on your perspective, this could be considered "trying to be too clever and potentially dangerous", but I think it's fine.
The "right" way, at least in my opinion, is by never declaring any intermediary "innerhashes" at all. Just use references directly:
my %outerHash;
$outerHash{Master1} = { key1 => 'value1', key2 => 'value2', key3 => 'value3'};
$outerHash{Master2} = { key4 => 'value4', key5 => 'value5', key6 => 'value6'};
$outerHash{Master3} = { key7 => 'value7', key8 => 'value8', key9 => 'value9'};
# or....
my %outerHash2;
$outerHash2{Master1}{key1} = 'value1';
$outerHash2{Master1}{key2} = 'value2';
$outerHash2{Master1}{key3} = 'value3';
$outerHash2{Master2}{key4} = 'value4';
$outerHash2{Master2}{key5} = 'value5';
$outerHash2{Master2}{key6} = 'value6';
$outerHash2{Master3}{key7} = 'value7';
$outerHash2{Master3}{key8} = 'value8';
$outerHash2{Master3}{key9} = 'value9';
# or...
my %outerHash3 = (
Master1 => {
key1 => 'value1',
key2 => 'value2',
key3 => 'value3'
}
Master2 => {
key4 => 'value4',
key5 => 'value5',
key6 => 'value6'
}
Master3 => {
key7 => 'value7',
key8 => 'value8',
key9 => 'value9'
}
);

how to query eXist using XPath?

I decided to use eXist as a database for an application that I am writing in Perl and
I am experimenting with it. The problem is that I have stored a .xml document with the following structure
<foo-bar00>
<perfdata datum="GigabitEthernet3_0_18">
<cli cmd="whatsup" detail="GigabitEthernet3/0/18" find="" given="">
<input_rate>3</input_rate>
<output_rate>3</output_rate>
</cli>
</perfdata>
<timeline>2011-5-23T11:15:33</timeline>
</foo-bar00>
and it is located in the "/db/LAB/foo-bar00/2011/5/23/11_15_33.xml" collection.
I can successfully query it, like
my $xquery = 'doc("/db/LAB/foo-bar00/2011/5/23/11_15_33.xml")' ;
or $xquery can be equal to
= doc("/db/LAB/foo-bar00/2011/5/23/11_15_33.xml")/foo-bar00/perfdata/cli/data(output_rate)
or
= doc("/db/LAB/foo-bar00/2011/5/23/11_15_33.xml")/foo-bar00/data(timeline)
my ($rc1, $set) = $eXist->executeQuery($xquery) ;
my ($rc2, $count) = $eXist->numberOfResults($set) ;
my ($rc3, #data) = $eXist->retrieveResults($set) ;
$eXist->releaseResultSet($set) ;
print Dumper(#data) ;
And the result is :
$VAR1 = {
'hitCount' => 1,
'foo-bar00' => {
'perfdata' => {
'cli' => {
'given' => '',
'detail' => 'GigabitEthernet3/0/18',
'input_rate' => '3',
'cmd' => 'whatsup',
'output_rate' => '3',
'find' => ''
},
'datum' => 'GigabitEthernet3_0_18'
},
'timeline' => '2011-5-23T11:15:33'
}
};
---> Given that I know the xml document that I want to retrieve info from.
---> Given that I want to retrieve the timeline information.
When I am writing :
my $db_xml_doc = "/db/LAB/foo-bar00/2011/5/23/11_15_33.xml" ;
my ($db_rc, $db_datum) = $eXist->queryXPath("/foo-bar00/timeline", $db_xml_doc, "") ;
print Dumper($db_datum) ;
The result is :
$VAR1 = {
'hash' => 1717362942,
'id' => 3,
'results' => [
{
'node_id' => '1.2',
'document' => '/db/LAB/foo-bar00/2011/5/23/11_15_33.xml'
}
]
};
The question is : How can I retrieve the "timeline" info ? Seems that the "node_id" variable (=1.2) can points to the "timeline" info, but how can I use it ?
Thank you.
use XML::LibXML qw( );
my $parser = XML::LibXML->new();
my $doc = $parser->parse_file('a.xml');
my $root = $doc->documentElement();
my ($timeline) = $root->findnodes('timeline');
if ($timeline) {
print("Exists: ", $timeline->textContent(), "\n");
}
or
my ($timeline) = $root->findnodes('timeline/text()');
if ($timeline) {
print("Exists: ", $timeline->getValue(), "\n");
}
I could have used /foo-bar00/timeline instead of timeline, but I didn't see the need.
Don't know if you're still interested, but you could either retrieve the doc as DOM and apply an xquery to the DOM, or, probably better, only pull out the info you want in the query that you submit to the server.
Something like this:
for $p in doc("/db/LAB/foo-bar00/2011/5/23/11_15_33.xml")//output_rate
return
<vlaue>$p</value>

represent allowed status transitions graph in Perl

There is something like status changes check logic in our app.
Currently checking is being handled by ugly if statement
I want to replace it by transition matrix:
my %allowed_status_changes = (
1 => (2,5),
2 => (1,2,3,4,5),
3 => (4,2),
4 => (3,2),
5 => (),
);
my $is_allowed_transition =
$submitted_status ~~ $allowed_status_changes {$original_status};
if ($prerequestsites && !$is_allowed_transition) {
return;
}
certain transitions can be allowed only on additional condition, therefore I will need something like
2 => (
(target => 1)
(target => 2, condition => $some_condition)
(target => (3,4), condition => $other_condition),
(target => 5)
),
(in my opinion it is too long)
What structure would you use in this situation if you should focus on readability and maintainability?
How you will parse it to check if transition is allowed?
If the conditions are very prevalent (e.g. almost every allowed transition has them) then your latter structure is perfectly fine, other than your syntax error of representing a hashref with "()" instead of "{}".
If the conditions are rare, I'd suggest going with #1, augmented by optional constructs similar to your #2.
Please note that readability of checking code is IMHO very clear though voluminous and not very idiomatic.
OTOH, maintainability of the matrix is high - you have terse yet readable syntax from #1 where no conditions are needed and a clear though longer syntax for conditions which is flexible enough for many conditions per many settings like your #2.
my %allowed_status_changes = (
1 => [2,5],
2 => [1,5,{targets=>[2], conditions=>[$some_condition]}
,{targets=>[3,4], conditions=>[$other_condition, $more_cond]}]
3 => [4,2],
4 => [3,2],
5 => [],
);
sub is_allowed_transition {
my ($submitted_status, $original_status ) = #_;
foreach my $alowed_status (#$allowed_status_changes{$original_status}) {
return 1 if !ref $alowed_status && $alowed_status == $submitted_status;
if (ref $alowed_status) {
foreach my $target (#$alowed_status{targets}) {
foreach my $condition (#$alowed_status{conditions}) {
return 1 if check_condition($submitted_status
, $original_status, $condition);
}
}
}
}
return 0;
}
if ($prerequestsites
&& !$is_allowed_transition($submitted_status, $original_status )) {
return;
}
Although I agree with DVK for the most part, I have to say, once you start delving into arrays of arrays of hashes, you're reaching a code complexity level that is hard to maintain without much spinning of heads and bugs.
At this point, I'd probably reach for an object and a class, for a bit of syntactic sugar.
my $transitions = TransitionGraph->new();
$transition->add( 1, { targets => [ 2, 5 ] });
$transition->add( 2, { targets => [ 1, 5 ] });
$transition->add( 2, { targets => [ 2 ], conditions => [ $some_condition ] });
$transition->add( 2, { targets => [ 3, 4 ], conditions => [ $other_condition, $more_cond ]});
$transition->add( 3, { targets => [4,2] } );
$transition->add( 4, { targets => [3,2] } );
$transition->add( 5, { targets => [] } );
if( $transition->allowed( 1 , 3 )){
}
Class implementation is up to the user, but I'd use Moose.
The primary benefits of this is you're encapsulating how the state graph works so you can Just Use it and worry about how the graph works seperate from where its used.
nb. in the above proposed API, add() creates a new record if one does not exist, and updates that record if it does exist. This turned out to be simpler than having "upgrade" methods or "get this item and then modify it" techniques.
Internally, it could do this, or something like it:
sub add {
my ( $self , $input_state, $rules ) = #_;
my $state;
if ( $self->has_state( $input_state ) ) {
$state = $self->get_state( $input_state );
} else {
$state = TransitionGraphState->new( source_id => $input_state );
$self->add_state( $input_state, $state );
}
my $targets = delete $rules{targets};
for my $target ( #$targets ) {
$state->add_target( $target, $rules );
}
return $self;
}
sub allowed {
my ( $self, $from, $to ) = #_;
if ( not $self->has_state( $from ) ){
croak "NO source state $from in transition graph";
}
my $state = $self->get_state( $from );
return $state->allowed_to( $to );
}
This also has the cool perk of not requiring one particular code set to work on the sub-nodes, you can create seperate instances with their own behaviour just in case you want one source state to be treated differently.
$transition->add_state( 2, $some_other_class_wich_works_like_transitiongraphstate );
Hope this is helpful =).
There is nothing wrong with the second form. You are not going to be able to get around the fact that you must encode the state machine somewhere. In fact, I think having the entire machine encoded in one place like that is far easier to understand that something with too many layers of abstraction where you need to look in n different places to understand the flow of the machine.