| Decision-ParseTree documentation | Contained in the Decision-ParseTree distribution. |
Decision::ParseTree - Replacing waterfall IF-ELSIF-ELSE blocks
Version 0.041
Death to long if-elsif-else blocks that are hard to maintain, and hard to explain to your manager. Heres an overly simplistic example:
if ( $obj->is_numeric ) {
if ( $obj->is_positive ) {
print 'Positive Number';
}
elsif ( $obj->is_negative )
print 'Negative Number';
}
else {
print 'Looks like zero';
}
else {
print 'Non-Numeric Value';
}
---
- is_num :
0 : Non-Numeric Value
1 : - is_pos :
1 : Positive Number
- is_neg :
= : Looks like zero
1 : Negative Number
...
package Rules;
use Scalar::Util;
sub is_num {
my ( $self, $obj ) = @_;
return (Scalar::Util::looks_like_number($obj->{value})) ? 1 : 0;
}
sub is_pos {
my ( $self, $obj ) = @_;
return ($obj->{value} > 0 ) ? 1 : 0;
}
sub is_neg {
my ( $self, $obj ) = @_;
return ($obj->{value} < 0 ) ? 1 : 0;
}
package Number;
sub new {
my ( $class, $value ) = @_
my $self = { parse_path => [],
value => $value };
return bless $self, $class;
}
use Decision::ParseTree q{ParseTree};
my $rules = Rules->new;
my $tree = LoadFile('tree.yaml');
print ParseTree( $tree, $rules, Number->new(10) ); # Positive Number
print ParseTree( $tree, $rules, Number->new(-1) ); # Negative Number
print ParseTree( $tree, $rules, Number->new(0) ); # Looks like zero
print ParseTree( $tree, $rules, Number->new('a')); # Non-Numeric Value
To make this all work we need a few parts:
So this all started as a way to make a decision tree thats easy to parse and easy to read for non-programmers. So to do this I looked to YAML, it's easy to read and easy to parse. Though make this work we have some hard and fast rules to follow for the tree construction:
Sometimes you have to make things messy before they can get clean.
Theres a flexibility that comes with breaking things apart in to nice, neat little chunks. By separating the rule logic in to one place you can make very complex rules that do not gunk up your code. You pull the order of these rules in to another place as it's completely possible that you would want to tweak the order. And lastly you need to glue these separate things together, so you have an object that gets passed thru to make this all work. Tada!
It would be nice to whip up a big example here to show all the interesting bits, sadly I can't think of a good example. Ideas?
$obj = Number->new(10);
ParseTree( $tree, $rules, $obj );
# $obj->{parse_path} will now look like :
# [ { 'is_num' => 1 },
# { 'is_pos' => 1 },
# ]
print $obj->{parse_answer}; # Positive Number
ParseTree is the only thing that can get exported, it's also the only thing in here, so export away.
Runs $obj thru $tree, using $rules as the library of rules.
Returns the first endpoint that you run into as the answer.
ben hengst, <notbenh at cpan.org>
Please report any bugs or feature requests to
bug-decision-parsetree at rt.cpan.org, or through the web interface at
http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Decision-ParseTree.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.
You can find documentation for this module with the perldoc command.
perldoc Decision::ParseTree
You can also look for information at:
Copyright 2007 ben hengst, all rights reserved.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
| Decision-ParseTree documentation | Contained in the Decision-ParseTree distribution. |
package Decision::ParseTree; use base qw{Exporter}; our @EXPORT_OK = qw{ParseTree}; use warnings; use strict;
our $VERSION = '0.041';
#=== FUNCTION ================================================================ # NAME: ParseTree # PURPOSE: walk a decision tree to get an answer # PARAMETERS: $tree : Expected to be a big array ref of stuff pulled from YAML # $rules: an object of rules that holds $tree's nodes # $obj : The concept is that this $obj is what is passed thru the # rules. So build your rules as though $obj will be passed # to them. # Also, there are two 'plugins' for $obj: # $obj->{parse_path} : if exists it will contain the path # that the $obj took # $obj->{parse_answer} : if exists it will hold the result # RETURNS: the proper value from $tree or undef # THROWS: there are many assertions that will die on failure # COMMENTS: none # SEE ALSO: the pod above for an explination and example #=============================================================================== sub ParseTree { use YAML; # to get YAML::Value use Carp::Assert::More; my($tree, $rules, $obj) = @_; assert_listref( $tree, q{A list of rules must be an array.} ); NODE : foreach my $task (@$tree) { assert_hashref( $task, q{Task nodes must be a hashref.} ); #--------------------------------------------------------------------------- # grab the values as they are the answers that we will check agenst #--------------------------------------------------------------------------- my ($answers) = values(%$task); assert_hashref( $answers, q{You answers need to be presented as a hashref.} ); #--------------------------------------------------------------------------- # grab the action #--------------------------------------------------------------------------- my ($action) = keys %$task; #--------------------------------------------------------------------------- # run the action to get the reply #--------------------------------------------------------------------------- assert_defined( $rules->can($action), q{Your rule needs to exist in your rules object.} ); my $reply = $rules->$action($obj); #--------------------------------------------------------------------------- # Log to the obj if theres a place to log to #--------------------------------------------------------------------------- if (defined $obj->{parse_path}) { push @{$obj->{parse_path}}, {$action => $reply}; } #--------------------------------------------------------------------------- # handle default YAML values if they exist if not by spec if we get # undef back we continue to the next node #--------------------------------------------------------------------------- if( !defined( $reply ) || !defined( $answers->{$reply} ) ) { if( defined $answers->{YAML::VALUE} ) { # YAML::Value is a constant in YAML that specifies any default (=) key $reply = YAML::VALUE; } else { next NODE; #continue if $reply is not an $answer } } #--------------------------------------------------------------------------- # Deal with sub trees #--------------------------------------------------------------------------- return ParseTree($answers->{$reply}, $rules, $obj) if ref($answers->{$reply}) eq q{ARRAY}; #--------------------------------------------------------------------------- # Deal with our answer #--------------------------------------------------------------------------- if (defined $obj->{parse_answer}) { $obj->{parse_answer} = $answers->{$reply}; } return $answers->{$reply}; } return undef; #catch all failure... this should never happen }
1; # End of Decision::ParseTree