{
package Node;
sub new{
my ($class, $data) = #_;
return bless $data, shift;
}
}
{
package BinarySearchTree;
sub new{
my ($class, $val) = #_;
return bless Node->new({val => $val}), $class
}
sub right{
my $self = shift;
return $self->{right}
}
sub data{
my $self = shift;
return $self->{val}
}
sub insert{
my ($self, $val) = #_;
if ($val > $self->{val}){
$self->{right} = Node->new({val => $val})
}elsif($val < $self->{val}){
$self->{left} = Node->new({val => $val})
}
}
}
1;
When i use this package
my $t = BinarySearchTree->new(5);
$t->insert(6);
print $t->right->data;
He gave me error
Can locate method 'data' via package 'Node', if i move method data to Node, they work fine.
How can i fix it , or rewrite this code .
Related
validate(
#_,
{
foo => {
callbacks => {
'smaller than a breadbox' => sub { shift() < $breadbox },
'green or blue' => sub {
return 1 if $_[0] eq 'green' || $_[0] eq 'blue';
&$failed(‘**fieldname** value is Invalid’);
}
bar => {
callbacks => {
'yellow or red' => sub {
return 1 if $_[0] eq 'yellow ' || $_[0] eq 'red';
&$failed(‘**fieldname** value is Invalid’);
}
}
}
}
);
Params::Validate - In the above code if my validation fails, I am calling the subroutine failed in which I am displaying the error message. I want to get field name from callbacks in params validate for which the validation has failed instead of directly passing the field name in the failed subroutine. Here foo and bar are fieldnames. How can I get the field name?
You could try something like this:
use strict;
use warnings;
use Params::Validate;
my %template =
(
bar => {
'color correct' => sub {
my ($fieldname, $value) = #_[0..1];
return 1 if $value eq 'green' || $value eq 'blue';
failed("'$fieldname': value '$value' is invalid");
}
},
foo => {
'smaller than a breadbox' => sub {
my ($fieldname, $value) = #_[0..1];
return 1 if $value < 20;
failed("'$fieldname' value '$value' is invalid");
}
}
);
func( bar => 'green', foo => 14 );
func( bar => 'yellow', foo => 17 );
sub func {
my %validate = map { $_ => { callbacks => get_callbacks( $_, $template{$_} ) } }
keys %template;
validate( #_, \%validate );
}
sub get_callbacks {
my ( $fname, $callbacks ) = #_;
my %cb;
for my $name (keys %$callbacks ) {
$cb{$name} = sub {
my $fieldname = $fname;
$callbacks->{$name}->( $fieldname, #_ )
};
}
return \%cb;
}
sub failed {
die $_[0];
}
Note: this uses closures to define a persistent fieldname variable. See perlsub for more information.
Below is my Code with the Hash
#!/usr/bin/perl
use warnings;
use JSON::PP; # Just 'use JSON;' on most systems
my %name = (
'sl' => {
'fsd' => {
'conf' => {
'ul' => '/sl/fsd/conf/ul',
'si' => '/sl/fsd/conf/si',
'ho1' => '/sl/fsd/conf/ho1'
}
}
},
're' => {
'fsd' => {
'cron' => {
'README' => '/re/fsd/cron/README'
},
'bin' => {
'db' => {
'smart.p_add_tag' => '/re/fsd/bin/db/smart.p_add_tag',
'smart.p_tag_partition' => '/re/fsd/bin/db/smart.p_tag_partition',
'smart.p_add_tag_type' => '/re/fsd/bin/db/smart.p_add_tag_type'
}
},
'doc' => {
'SMART' => '/re/fsd/doc/SMART',
'README' => '/re/fsd/doc/README'
},
'data' => {
'README' => '/re/fsd/data/README'
},
'conf' => {
'al1' => '/re/fsd/conf/al1',
'file' => '/re/fsd/conf/file',
'ho' => '/re/fsd/conf/ho',
'al3' => '/re/fsd/conf/al3',
'hst' => '/re/fsd/conf/hst',
'us' => '/re/fsd/conf/us',
'README' => '/re/fsd/conf/README',
'al2' => '/re/fsd/conf/al2'
}
}
}
);
(my $root) = keys %name;
my %nodes = ();
my %tree = ();
my #queue = ($root);
list_children(\%name, \#queue, \%nodes) while #queue;
my $tree = build_tree($root, \%nodes);
my $json = JSON::PP->new->pretty; # prettify for human consumption
print $json->encode($tree);
sub list_children {
my $adjac = shift;
my $queue = shift;
my $nodes = shift;
my $node = shift #$queue;
my #children = keys %{$adjac->{$node}};
#children = grep { ! exists $nodes->{$_}} #children;
$nodes->{$node} = \#children;
push #$queue, #children;
}
sub build_tree {
my $root = shift;
my $nodes = shift;
my #children;
for my $child (#{$nodes->{$root}}) {
push #children, build_tree($child, $nodes);
}
my %h = ('text' => $root,
'children' => \#children);
return \%h;
}
I'm trying to output JSONified hash, but it is only traversing upto two levels. whereas i need it to traverse all upto the last child node of each parent. Can someone please help to achieve this.
Below is current output
{
"text" : "sl",
"children" : [
{
"text" : "fsd",
"children" : []
}
]
}
Normally, transforming the hash, and then json-ing is not the most efficient idea, because you're going to make one traversal to transform the hash and JSON's going to make one to json-ify it, and JSON is a type of transform of a hash.
However, JSON is usually done with XS, which means that the second traversal is faster, at least. That and JSON behavior is standardized.
use 5.016;
use strict;
use warnings;
use Data::Dumper ();
use JSON;
my $hash
= {
'Foods' => {
'fruits' => {
'orange' => '1',
'apple' => '2',
},
'Vegetables' => {
'tomato' => '3',
'carrot' => '1',
'cabbage' => '2',
}
}
};
sub descend {
my ( $structure, $block ) = #_;
my $res;
while ( my ( $k, $v ) = each %$structure ) {
$block->( $structure, $k, $v );
if ( ref( $v ) eq 'HASH' ) {
$res = descend( $v, $block );
}
}
return $res;
}
my $new = {};
my $curr = $new;
descend( $hash => sub {
my ( $lvl, $k, $v ) = #_;
my $node = { text => $k };
$curr->{children} //= [];
push $curr->{children}, $node;
if ( ref( $v ) eq 'HASH' ) {
$curr = $node;
}
else {
$node->{children} = { text => $v };
}
});
# allow for the root-level special case, and retrieve the first child.
$new = $new->{children}[0];
say Data::Dumper->Dump( [ $new ], [ '$new' ] );
say JSON->new->encode( $new );
Having a simple example code
use Modern::Perl;
use Data::Dumper;
package My;
use Moose;
use Method::Signatures::Simple;
has 'result' => (
is => 'rw',
isa => 'HashRef',
default => sub{{}},
clearer => 'clear_result'
);
method run {
$self->clear_result; #clearing the result
$self->result( $self->run_part1 );
$self->do_something;
$self->result( $self->run_part3 ); #need merge
}
method do_something {
$self->result( $self->run_part2 ); #need merge
}
method run_part1 { return { aaa => 'aaa' } }
method run_part2 { return { bbb => 'bbb' } }
method run_part3 { return { ccc => 'ccc' } }
package main;
my $p = My->new;
say Dumper $p->run;
the result (ofcourse) is:
$VAR1 = {
'ccc' => 'ccc'
};
I want the result:
$VAR1 = {
'aaa' => 'aaa'
'bbb' => 'bbb'
'ccc' => 'ccc'
};
so, the question is - how to merge the $self->result HashRef when setting it?
Yes, i can add new method add_result like:
method add_result($hr) {
use Hash::Merge::Simple qw(merge);
$self->result( merge $self->result, $hr );
}
and change everywhere in my code the $self->result to $self->add_result but wonder if there is another solution...
has 'result' => (
acccessor => '_result',
isa => 'HashRef',
default => sub{{}},
clearer => 'clear_result'
);
sub result {
my $self = shift;
if (#_) {
my ($hr) = #_;
return $self->_result( ... merged hash ...);
} else {
return $self->_result();
}
}
Perl's Moose is different from other object systems, so it's not always clear how to translate an example known from other languages into Moose lingo. Consider the following Java example of Rectangle and Square, where a Square instance (a square being a special rectangle) delegates calls to area() to an instance of Rectangle to which it hold a private reference.
package geometry;
class Rectangle {
private int x;
private int y;
public Rectangle(int x, int y) {
this.x = x;
this.y = y;
}
public int area() {
return x * y;
}
}
class Square {
private Rectangle rectangle;
public Square(int a) {
this.rectangle = new Rectangle(a, a);
}
public int area() {
return this.rectangle.area();
}
}
public class Main {
public static void main( String[] args ) {
int x, y;
if ( args.length > 1 ) {
x = Integer.parseInt( args[0] );
y = Integer.parseInt( args[1] );
}
else {
x = 3;
y = 7;
}
Rectangle r = new Rectangle( x, y );
System.out.println( r.area() );
Square sq1 = new Square( x );
System.out.println( sq1.area() );
Square sq2 = new Square( y );
System.out.println( sq2.area() );
}
}
I've cobbled together the following Perl/Moose/Mouse version, which I'm not sure is the right way to do things, so I'm submitting it to the judgment of the guild of experts assembled in these halls:
package Rectangle;
use Mouse;
has [ qw( x y ) ], is => 'ro', isa => 'Int';
sub area {
my( $self ) = #_;
return $self->x * $self->y;
}
package Square;
use Mouse;
has x => is => 'ro', isa => 'Int';
has rectangle => is => 'ro', isa => 'Rectangle';
# The tricky part: modify the constructor.
around BUILDARGS => sub {
my $orig = shift;
my $class = shift;
my %args = #_ == 1 ? %{ $_[0] } : #_;
$args{rectangle} = Rectangle->new( x => $args{x}, y => $args{x} );
return $class->$orig( \%args );
};
sub area { $_[0]->rectangle->area } # delegating
package main;
use strict;
my $x = shift || 3;
my $y = shift || 7;
my $r = Rectangle->new( x => $x, y => $y);
my $sq1 = Square->new( x => $x );
my $sq2 = Square->new( x => $y );
print $_->area, "\n" for $r, $sq1, $sq2;
This works, but as I haven't seen much Moose in action, I'm just not sure this is the way to go, or if there is an even easier way. Thanks for any feedback, or pointers for more Moose user-level discussion.
While I am not sure this is best practice, probably best translation I can think of would be something like this:
package Rectangle;
use Mouse;
has [ qw( x y ) ], is => 'ro', isa => 'Int';
sub area {
my( $self ) = #_;
return $self->x * $self->y;
}
package Square;
use Mouse;
has x => is => 'ro', isa => 'Int';
has rectangle =>
is => 'ro',
isa => 'Rectangle',
lazy_build => 1,
handles => [ 'area' ];
sub _build_rectangle {
my $self = shift;
Rectangle->new(x => $self->x, y => $self->x);
}
The handles in rectangle attribute automatically builds delegation to area for you.
This is how I'd do it with Moose. It's pretty much identical to the Mouse version:
use 5.012;
use Test::Most;
{
package Rectangle;
use Moose;
has [qw(x y)] => ( is => 'ro', isa => 'Int' );
sub area {
my $self = shift;
return $self->x * $self->y;
}
}
{
package Square;
use Moose;
has [qw(x y)] => ( is => 'ro', isa => 'Int' );
has rectangle =>
( isa => 'Rectangle', lazy_build => 1, handles => ['area'] );
sub _build_rectangle {
my $self = shift;
Rectangle->new( x => $self->x, y => $self->y );
}
}
my #dimensions
= ( [qw(Rectangle 3 7 21 )], [qw(Square 3 3 9 )], [qw(Square 3 7 21 )] );
for my $dimension (#dimensions) {
my ( $shape, $x, $y, $area ) = #{$dimension};
my $rect = new_ok $shape, [ x => $x, y => $y ];
is $area, $rect->area, "area of $shape ($x, $y) => $area";
}
done_testing;
Tie::Hash has these:
sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
sub NEXTKEY { each %{$_[0]} }
NEXTKEY takes two arguments, one of which is the last key but that arg is never referenced?
The various Tie docs don't shed any light on this other than this in perltie:
my $a = keys %{$self->{LIST}}; # reset each() iterator
looking at the doc for each doesn't add to this.
What's going on?
You only need to worry about the second argument to NEXTKEY if you care about which key was accessed last. By default, hashes don't care about the order, so it is not used.
As for the second part, the keys function in scalar context returns the number of items in the hash. Any call to keys resets the iterator used by keys and each because it exhausts the iterator.
A call to keys is really a call to FIRSTKEY and calls to NEXTKEY until there are no more items left in that haven't been returned.
A call to each is a call to FIRSTKEY (if FIRSTKEY hasn't been called yet) or a call to NEXTKEY (if FIRSTKEY has been called).
#!/usr/bin/perl
use strict;
use warnings;
my $i = 0;
tie my %h, "HASH::Sorted", map { $_ => $i++ } "a" .. "g";
for my $key (keys %h) {
print "$key => $h{$key}\n";
}
print "\n";
my $first = each %h;
print "first $first => $h{$first}\n";
my ($second_key, $second_value) = each %h;
print "second $second_key => $second_value\n";
print "\nall of them again:\n";
for my $key (keys %h) {
print "$key => $h{$key}\n";
}
package HASH::Sorted;
sub TIEHASH {
my $class = shift;
return bless { _hash => { #_ } }, $class;
}
sub FETCH {
my ($self, $key) = #_;
return $self->{_hash}{$key};
}
sub STORE {
my ($self, $key, $value) = #_;
return $self->{_hash}{$key} = $value;
}
sub DELETE {
my ($self, $key) = #_;
return delete $self->{_hash}{$key};
}
sub CLEAR {
my $self = shift;
%{$self->{_hash}} = ();
}
sub EXISTS {
my ($self, $key) = #_;
return exists $self->{_hash}{$key};
}
sub FIRSTKEY {
my $self = shift;
#build iterator
$self->{_list} = [ sort keys %{$self->{_hash}} ];
return $self->NEXTKEY;
}
sub NEXTKEY {
my $self = shift;
return shift #{$self->{_list}};
}
sub SCALAR {
my $self = shift;
return scalar %{$self->{_hash}};
}
This one uses a custom each method to allow you to iterate over the sorted hash more than one time. All of the standard rules about not being allowed to add or remove keys are still in effect though. It would be trivial to add a warning that iterators were still in use on a call to STORE or DELETE.
#!/usr/bin/perl
use strict;
use warnings;
my $i = 0;
tie my %h, "HASH::Sorted", map { $_ => $i++ } "a" .. "g";
for my $key (keys %h) {
print "$key => $h{$key}\n";
}
print "\n";
my $first = each %h;
print "first $first => $h{$first}\n";
my ($second_key, $second_value) = each %h;
print "second $second_key => $second_value\n";
print "\nall of them again:\n";
for my $key (keys %h) {
print "$key => $h{$key}\n";
}
print "\nmultiple iterators\n";
my $o = tied %h;
while (my ($k, $v) = $o->each("outer")) {
print "$k => $v\n";
while (my ($k, $v) = $o->each("inner")) {
print "\t$k => $v\n";
}
}
print "\nhybrid solution\n";
while (my ($k, $v) = each %h) {
print "$k => $v\n";
#the iter_name is an empty string
while (my ($k, $v) = $o->each) {
print "\t$k => $v\n";
}
}
package HASH::Sorted;
sub each {
my ($self, $iter_name) = (#_, "DEFAULT");
#each has not been called yet for this iter
unless (exists $self->{_iters}{$iter_name}) {
$self->{_iters}{$iter_name} = [ sort keys %{$self->{_hash}} ];
}
#end of list
unless (#{$self->{_iters}{$iter_name}}) {
delete $self->{_iters}{$iter_name};
return;
}
my $key = shift #{$self->{_iters}{$iter_name}};
if (wantarray) {
return $key, $self->{_hash}{$key};
}
return $key;
}
sub TIEHASH {
my $class = shift;
return bless {
_hash => { #_ },
_iters => {},
}, $class;
}
sub FETCH {
my ($self, $key) = #_;
return $self->{_hash}{$key};
}
sub STORE {
my ($self, $key, $value) = #_;
return $self->{_hash}{$key} = $value;
}
sub DELETE {
my ($self, $key) = #_;
return delete $self->{_hash}{$key};
}
sub CLEAR {
my $self = shift;
%{$self->{_hash}} = ();
}
sub EXISTS {
my ($self, $key) = #_;
return exists $self->{_hash}{$key};
}
sub FIRSTKEY {
my $self = shift;
#build iterator
$self->{_list} = [ sort keys %{$self->{_hash}} ];
return $self->NEXTKEY;
}
sub NEXTKEY {
my $self = shift;
return shift #{$self->{_list}};
}
sub SCALAR {
my $self = shift;
return scalar %{$self->{_hash}};
}