AI-ExpertSystem-Simple
view release on metacpan or search on metacpan
bin/simpleshell view on Meta::CPAN
process_log();
if ( $r eq 'question' ) {
$s->answer( ask_question( $s->get_question() ) );
}
elsif ( $r eq 'finished' ) {
say_status('The answer is : ' . $s->get_answer());
$s->explain();
process_log( 'explaination' , 1);
$running = undef;
}
elsif ( $r eq 'failed' ) {
say_status("Unable to answer your question");
$running = undef;
}
}
if($tkinterface) {
$continue = 'no';
} else {
$continue = ask_question( 'Another consoltation', 'yes', 'no' );
$s->reset();
}
}
lib/AI/ExpertSystem/Simple.pm view on Meta::CPAN
sub new {
my ($class) = @_;
die "Simple->new() takes no arguments" if scalar(@_) != 1;
my $self = {};
$self->{_rules} = ();
$self->{_knowledge} = ();
$self->{_goal} = undef;
$self->{_filename} = undef;
$self->{_ask_about} = undef;
$self->{_told_about} = undef;
$self->{_log} = ();
$self->{_number_of_rules} = 0;
$self->{_number_of_attributes} = 0;
$self->{_number_of_questions} = 0;
return bless $self, $class;
}
lib/AI/ExpertSystem/Simple.pm view on Meta::CPAN
die "Simple->reset() takes no arguments" if scalar(@_) != 1;
foreach my $name (keys %{$self->{_rules}}) {
$self->{_rules}->{$name}->reset();
}
foreach my $name (keys %{$self->{_knowledge}}) {
$self->{_knowledge}->{$name}->reset();
}
$self->{_ask_about} = undef;
$self->{_told_about} = undef;
$self->{_log} = ();
}
sub load {
my ($self, $filename) = @_;
die "Simple->load() takes 1 argument" if scalar(@_) != 2;
die "Simple->load() argument 1 (FILENAME) is undefined" if !defined($filename);
if(-f $filename and -r $filename) {
my $twig = XML::Twig->new(
twig_handlers => { goal => sub { $self->_goal(@_) },
rule => sub { $self->_rule(@_) },
question => sub { $self->_question(@_) } }
);
$twig->safe_parsefile($filename);
lib/AI/ExpertSystem/Simple.pm view on Meta::CPAN
$self->_add_to_log( "The goal attibutes is " . $self->{_goal}->name() );
return 1;
} else {
die "Simple->load() unable to use file";
}
}
sub _goal {
my ($self, $t, $node) = @_;
my $attribute = undef;
my $text = undef;
my $x = ($node->children('attribute'))[0];
$attribute = $x->text();
$x = ($node->children('text'))[0];
$text = $x->text();
$self->{_goal} = AI::ExpertSystem::Simple::Goal->new($attribute, $text);
eval { $t->purge(); }
}
sub _rule {
my ($self, $t, $node) = @_;
my $name = undef;
my $x = ($node->children('name'))[0];
$name = $x->text();
if(!defined($self->{_rules}->{$name})) {
$self->{_rules}->{$name} = AI::ExpertSystem::Simple::Rule->new($name);
$self->{_number_of_rules}++;
}
foreach $x ($node->get_xpath('//condition')) {
my $attribute = undef;
my $value = undef;
my $y = ($x->children('attribute'))[0];
$attribute = $y->text();
$y = ($x->children('value'))[0];
$value = $y->text();
$self->{_rules}->{$name}->add_condition($attribute, $value);
if(!defined($self->{_knowledge}->{$attribute})) {
$self->{_number_of_attributes}++;
$self->{_knowledge}->{$attribute} = AI::ExpertSystem::Simple::Knowledge->new($attribute);
}
}
foreach $x ($node->get_xpath('//action')) {
my $attribute = undef;
my $value = undef;
my $y = ($x->children('attribute'))[0];
$attribute = $y->text();
$y = ($x->children('value'))[0];
$value = $y->text();
$self->{_rules}->{$name}->add_action($attribute, $value);
if(!defined($self->{_knowledge}->{$attribute})) {
lib/AI/ExpertSystem/Simple.pm view on Meta::CPAN
$self->{_knowledge}->{$attribute} = AI::ExpertSystem::Simple::Knowledge->new($attribute);
}
}
eval { $t->purge(); }
}
sub _question {
my ($self, $t, $node) = @_;
my $attribute = undef;
my $text = undef;
my @responses = ();
$self->{_number_of_questions}++;
my $x = ($node->children('attribute'))[0];
$attribute = $x->text();
$x = ($node->children('text'))[0];
$text = $x->text();
lib/AI/ExpertSystem/Simple.pm view on Meta::CPAN
if($self->{_knowledge}->{$n}->is_value_set()) {
return 'finished';
}
if($self->{_ask_about}) {
my %answers = ();
$answers{$self->{_ask_about}}->{value} = $self->{_told_about};
$answers{$self->{_ask_about}}->{setter} = '';
$self->{_ask_about} = undef;
$self->{_told_about} = undef;
while(%answers) {
my %old_answers = %answers;
%answers = ();
foreach my $answer (keys(%old_answers)) {
my $n = $answer;
my $v = $old_answers{$answer}->{value};
my $s = $old_answers{$answer}->{setter};
lib/AI/ExpertSystem/Simple.pm view on Meta::CPAN
die "Simple->get_question() takes no arguments" if scalar(@_) != 1;
return $self->{_knowledge}->{$self->{_ask_about}}->get_question();
}
sub answer {
my ($self, $value) = @_;
die "Simple->answer() takes 1 argument" if scalar(@_) != 2;
die "Simple->answer() argument 1 (VALUE) is undefined" if ! defined($value);
$self->{_told_about} = $value;
}
sub get_answer {
my ($self) = @_;
die "Simple->get_answer() takes no arguments" if scalar(@_) != 1;
my $n = $self->{_goal}->name();
lib/AI/ExpertSystem/Simple.pm view on Meta::CPAN
=item Simple->reset() takes no arguments
When the method is called it requires no arguments. This message is given if
some arguments were supplied.
=item Simple->load() takes 1 argument
When the method is called it requires one argument. This message is given if more or
less arguments were supplied.
=item Simple->load() argument 1 (FILENAME) is undefined
The corrct number of arguments were supplied with the method call, however the first
argument, FILENAME, was undefined.
=item Simple->load() XML parse failed
XML Twig encountered some errors when trying to parse the XML knowledgebase.
=item Simple->load() unable to use file
The file supplied to the load( ) method could not be used as it was either not a file
or not readable.
lib/AI/ExpertSystem/Simple.pm view on Meta::CPAN
=item Simple->get_question() takes no arguments
When the method is called it requires no arguments. This message is given if
some arguments were supplied.
=item Simple->answer() takes 1 argument
When the method is called it requires one argument. This message is given if more or
less arguments were supplied.
=item Simple->answer() argument 1 (VALUE) is undefined
The corrct number of arguments were supplied with the method call, however the first
argument, VALUE, was undefined.
=item Simple->get_answer() takes no arguments
When the method is called it requires no arguments. This message is given if
some arguments were supplied.
=item Simple->log() takes no arguments
When the method is called it requires no arguments. This message is given if
some arguments were supplied.
lib/AI/ExpertSystem/Simple/Goal.pm view on Meta::CPAN
use warnings;
our $VERSION = '1.0';
sub new {
my ($class, $name, $message) = @_;
# Check the input
die "Goal->new() takes 2 arguments" if scalar(@_) != 3;
die "Goal->new() argument 1 (NAME) is undefined" if ! defined($name);
die "Goal->new() argument 2 (MESSAGE) is undefined" if ! defined($message);
# All OK, create the object
my $self = {};
$self->{_name} = $name;
$self->{_message} = $message;
return bless $self, $class;
}
sub is_goal {
my ($self, $name) = @_;
# Check the input
die "Goal->is_goal() takes 1 argument" if scalar(@_) != 2;
die "Goal->is_goal() argument 1 (NAME) is undefined" if ! defined($name);
# All OK, do the stuff
return $self->{_name} eq $name;
}
sub name {
my ($self) = @_;
# Check the input
lib/AI/ExpertSystem/Simple/Goal.pm view on Meta::CPAN
return $self->{_name};
}
sub answer {
my ($self, $value) = @_;
# Check the input
die "Goal->answer() takes 1 argument" if scalar(@_) != 2;
die "Goal->answer() argument 1 (VALUE) is undefined" if ! defined($value);
# All OK, do the stuff
my @text = ();
foreach my $word (split('\s', $self->{_message})) {
if($word eq $self->{_name}) {
push(@text, $value);
} else {
push(@text, $word);
lib/AI/ExpertSystem/Simple/Goal.pm view on Meta::CPAN
None
=head1 DIAGNOSTICS
=over 4
=item Goal->new() takes 2 arguments
When the constructor is initialised it requires two arguments. This message is given if more or less arguments were supplied.
=item Goal->new() argument 1 (NAME) is undefined
The correct number of arguments were supplied to the constructor, however the first argument, NAME, was undefined.
=item Goal->new() argument 2 (MESSAGE) is undefined
The correct number of arguments were supplied to the constructor, however the second argument, MESSAGE, was undefined.
=item Goal->is_goal() takes 1 argument
When the method is called it requires one argument. This message is given if more or less arguments were supplied.
=item Goal->is_goal() argument 1 (NAME) is undefined
The correct number of arguments were supplied with the method call, however the first argument, NAME, was undefined.
=item Goal->name() takes no arguments
When the method is called it takes no arguments. This message is given if some were supplied.
=item Goal->answer() takes 1 argument
When the method is called it requires one argument. This message is given if more or less arguments were supplied.
=item Goal->answer() argument 1 (VALUE) is undefined
The correct number of arguments were supplied with the method call, however the first argument, VALUE, was undefined.
=back
=head1 BUGS
None to date
=head1 FILES
See Goal.t in the test directory
lib/AI/ExpertSystem/Simple/Knowledge.pm view on Meta::CPAN
use strict;
use warnings;
our $VERSION = '1.2';
sub new {
my ($class, $name) = @_;
die "Knowledge->new() takes 1 argument" if scalar(@_) != 2;
die "Knowledge->new() argument 1, (NAME) is undefined" if ! defined($name);
my $self = {};
$self->{_name} = $name;
$self->{_value} = undef;
$self->{_setter} = undef;
$self->{_question} = undef;
$self->{_responses} = ();
return bless $self, $class;
}
sub reset {
my ($self) = @_;
die "Knowledge->reset() takes no arguments" if scalar(@_) != 1;
$self->{_value} = undef;
$self->{_setter} = undef;
}
sub set_value {
my ($self, $value, $setter) = @_;
die "Knowledge->set_value() takes 2 argument" if scalar(@_) != 3;
die "Knowledge->set_value() argument 1, (VALUE) is undefined" if ! defined($value);
die "Knowledge->set_value() argument 2, (SETTER) is undefined" if ! defined($setter);
if(defined($self->{_value})) {
die "Knowledge->set_value() has already been set";
}
$self->{_value} = $value;
$self->{_setter} = $setter;
}
sub get_value {
lib/AI/ExpertSystem/Simple/Knowledge.pm view on Meta::CPAN
}
sub set_question {
my ($self, $question, @responses) = @_;
if(defined($self->{_question})) {
die "Knowledge->set_question() has already been set";
}
die "Knowledge->set_question() takes 2 arguments" if scalar(@_) < 3;
die "Knowledge->set_question() argument 1, (QUESTION) is undefined" if ! defined($question);
# This test just doesnt work for a list
# die "Knowledge->set_question() argument 2, (RESPONSES) is undefined" if scalar(@responses) == 0;
$self->{_question} = $question;
push(@{$self->{_responses}}, @responses);
}
sub get_question {
my ($self) = @_;
die "Knowledge->get_question() takes no arguments" if scalar(@_) != 1;
lib/AI/ExpertSystem/Simple/Knowledge.pm view on Meta::CPAN
None
=head1 DIAGNOSTICS
=over 4
=item Knowledge->new() takes 1 argument
When the constructor is initialised it requires one argument. This message is given if more of less arguments are given.
=item Knowledge->new() argument 1, (NAME) is undefined
The correct number of arguments were supplied to the constructor, however the first argument, NAME, was undefined.
=item Knowledge->reset() takes no arguments
When the method is called it requires no arguments. This message is given if some where supplied.
=item Knowledge->set_value() takes 2 argument
When the method is called it requires two arguments. This message is given if more of less arguments are given.
=item Knowledge->set_value() argument 1, (VALUE) is undefined
The correct number of arguments were supplied to the method call, however the first argument, VALUE, was undefined.
=item Knowledge->set_value() argument 2, (SETTER) is undefined
The correct number of arguments were supplied to the method call, however the second argument, SETTER, was undefined.
=item Knowledge->set_value() has already been set
This method has already been called and the value set. It cannot be called twice.
=item Knowledge->get_value() takes no arguments
When the method is called it requires no arguments. This message is given if some where supplied.
=item Knowledge->get_setter() takes no arguments
lib/AI/ExpertSystem/Simple/Knowledge.pm view on Meta::CPAN
When the method is called it requires no arguments. This message is given if some where supplied.
=item Knowledge->is_value_set() takes no arguments
When the method is called it requires no arguments. This message is given if some where supplied.
=item Knowledge->set_question() takes 2 arguments
When the method is called it requires two arguments. This message is given if more of less arguments are given.
=item Knowledge->set_question() argument 1, (QUESTION) is undefined
The correct number of arguments were supplied to the method call, however the first argument, QUESTION, was undefined.
=item Knowledge->set_question() has already been set
This method has already been called and the value set. It cannot be called twice.
=item Knowledge->get_question() takes no arguments
When the method is called it requires no arguments. This message is given if some where supplied.
=item Knowledge->get_question() has not been set
lib/AI/ExpertSystem/Simple/Rule.pm view on Meta::CPAN
use strict;
use warnings;
our $VERSION = '1.2';
sub new {
my ($class, $name) = @_;
die "Rule->new() takes 1 argument" if(scalar(@_) != 2);
die "Rule->new() argument 1 (NAME) is undefined" if(!defined($name));
my $self = {};
$self->{_name} = $name;
$self->{_conditions} = ();
$self->{_tested} = ();
$self->{_counter} = 0;
$self->{_actions} = ();
$self->{_state} = 'active';
lib/AI/ExpertSystem/Simple/Rule.pm view on Meta::CPAN
foreach my $name (keys %{$self->{_tested}}) {
$self->{_tested}->{$name} = 0;
$self->{_counter}++;
}
}
sub add_condition {
my ($self, $name, $value) = @_;
die "Rule->add_condition() takes 2 arguments" if(scalar(@_) != 3);
die "Rule->add_condition() argument 1 (NAME) is undefined" if(!defined($name));
die "Rule->add_condition() argument 2 (VALUE) is undefined" if(!defined($value));
if(defined($self->{_conditions}->{$name})) {
die "Rule->add_condition() has already been set";
}
$self->{_conditions}->{$name} = $value;
$self->{_tested}->{$name} = 0;
$self->{_counter}++;
}
sub add_action {
my ($self, $name, $value) = @_;
die "Rule->add_action() takes 2 arguments" if(scalar(@_) != 3);
die "Rule->add_action() argument 1 (NAME) is undefined" if(!defined($name));
die "Rule->add_action() argument 2 (VALUE) is undefined" if(!defined($value));
if(defined($self->{_actions}->{$name})) {
die "Rule->add_action() has already been set";
}
$self->{_actions}->{$name} = $value;
}
sub name {
my ($self) = @_;
lib/AI/ExpertSystem/Simple/Rule.pm view on Meta::CPAN
die "Rule->state() takes no arguments" if(scalar(@_) != 1);
return $self->{_state};
}
sub given {
my ($self, $name, $value) = @_;
die "Rule->given() takes 2 arguments" if(scalar(@_) != 3);
die "Rule->given() argument 1 (NAME) is undefined" if(!defined($name));
die "Rule->given() argument 2 (VALUE) is undefined" if(!defined($value));
if(defined($self->{_conditions}->{$name})) {
if($self->{_tested}->{$name} == 1) {
# Already done this one
} elsif($self->{_conditions}->{$name} eq $value) {
$self->{_tested}->{$name} = 1;
$self->{_counter}--;
if($self->{_counter} == 0) {
$self->{_state} = 'completed';
}
lib/AI/ExpertSystem/Simple/Rule.pm view on Meta::CPAN
None
=head1 DIAGNOSTICS
=over 4
=item Rule->new() takes 1 argument
When the constructor is initialised it requires one argument. This message is given if more or less arguments were supplied.
=item Rule->new() argument 1 (NAME) is undefined
The corrct number of arguments were supplied to the constructor, however the first argument, NAME, was undefined.
=item Rule->reset() takes no arguments
When the method is called it requires no arguments. This message is given if more or less arguments were supplied.
=item Rule->add_condition() takes 2 arguments
When the method is called it requires two arguments. This message is given if more or less arguments were supplied.
=item Rule->add_condition() argument 1 (NAME) is undefined
The corrct number of arguments were supplied with the method call, however the first argument, NAME, was undefined.
=item Rule->add_condition() argument 2 (VALUE) is undefined
The corrct number of arguments were supplied with the method call, however the second argument, VALUE, was undefined.
=item Rule->add_condition() has already been set
This method has already been called and the value set. It cannot be called twice.
=item Rule->add_action() takes 2 arguments
When the method is called it requires two arguments. This message is given if more or less arguments were supplied.
=item Rule->add_action() argument 1 (NAME) is undefined
The corrct number of arguments were supplied with the method call, however the first argument, NAME, was undefined.
=item Rule->add_action() argument 2 (VALUE) is undefined
The corrct number of arguments were supplied with the method call, however the second argument, VALUE, was undefined.
=item Rule->add_action() has already been set
This method has already been called and the value set. It cannot be called twice.
=item Rule->name() takes no arguments
When the method is called it requires no arguments. This message is given if more or less arguments were supplied.
=item Rule->state() takes no arguments
When the method is called it requires no arguments. This message is given if more or less arguments were supplied.
=item Rule->given() takes 2 arguments
When the method is called it requires two arguments. This message is given if more or less arguments were supplied.
=item Rule->given() argument 1 (NAME) is undefined
The corrct number of arguments were supplied with the method call, however the first argument, NAME, was undefined.
=item Rule->given() argument 2 (VALUE) is undefined
The corrct number of arguments were supplied with the method call, however the second argument, VALUE, was undefined.
=item Rule->actions() takes no arguments
When the method is called it requires no arguments. This message is given if more or less arguments were supplied.
=item Rule->conditions() takes no arguments
When the method is called it requires no arguments. This message is given if more or less arguments were supplied.
=item Rule->unresolved() takes no arguments
eval { my $x = AI::ExpertSystem::Simple::Goal->new(); };
like($@, qr/^Goal->new\(\) takes 2 arguments /, 'Too few arguments');
eval { my $x = AI::ExpertSystem::Simple::Goal->new('fred'); };
like($@, qr/^Goal->new\(\) takes 2 arguments /, 'Too few arguments');
eval { my $x = AI::ExpertSystem::Simple::Goal->new('fred', 'a message', 'that is too long'); };
like($@, qr/^Goal->new\(\) takes 2 arguments /, 'Too many arguments');
eval { my $x = AI::ExpertSystem::Simple::Goal->new(undef, 'message'); };
like($@, qr/^Goal->new\(\) argument 1 \(NAME\) is undefined /, 'Name is undefined');
eval { my $x = AI::ExpertSystem::Simple::Goal->new('fred', undef); };
like($@, qr/^Goal->new\(\) argument 2 \(MESSAGE\) is undefined /, 'Message is undefined');
################################################################################
# Create a AI::ExpertSystem::Simple::Goal correctly
################################################################################
my $x = AI::ExpertSystem::Simple::Goal->new('fred', 'this is the fred');
isa_ok($x, 'AI::ExpertSystem::Simple::Goal');
################################################################################
# Check that the name is recalled
################################################################################
# Check the goal
################################################################################
eval { $x->is_goal(); };
like($@, qr/^Goal->is_goal\(\) takes 1 argument /, 'Too few arguments');
eval { $x->is_goal(1, 2); };
like($@, qr/^Goal->is_goal\(\) takes 1 argument /, 'Too many arguments');
eval { $x->is_goal(undef); };
like($@, qr/^Goal->is_goal\(\) argument 1 \(NAME\) is undefined /, 'name is undefined');
is($x->is_goal('fred'), '1', 'Matches the goal');
is($x->is_goal('tom'), '', 'Does not matches the goal');
################################################################################
# Check the goal
################################################################################
eval { $x->answer(); };
like($@, qr/^Goal->answer\(\) takes 1 argument /, 'Too few arguments');
eval { $x->answer(1, 2); };
like($@, qr/^Goal->answer\(\) takes 1 argument /, 'Too many arguments');
eval { $x->answer(undef); };
like($@, qr/^Goal->answer\(\) argument 1 \(VALUE\) is undefined /, 'Value is undefined');
is($x->answer('banana'), 'this is the banana', 'Get the answer');
t/Knowledge.t view on Meta::CPAN
################################################################################
# Create a Rule incorrectly
################################################################################
eval { my $x = AI::ExpertSystem::Simple::Knowledge->new(); };
like($@, qr/^Knowledge->new\(\) takes 1 argument /, 'Too few arguments');
eval { my $x = AI::ExpertSystem::Simple::Knowledge->new(1,2); };
like($@, qr/^Knowledge->new\(\) takes 1 argument /, 'Too many arguments');
eval { my $x = AI::ExpertSystem::Simple::Knowledge->new(undef); };
like($@, qr/^Knowledge->new\(\) argument 1, \(NAME\) is undefined /, 'Name is undefined');
isnt($@, '', 'Died, incorrect number of arguments');
################################################################################
# Create a Rule correctly
################################################################################
my $x = AI::ExpertSystem::Simple::Knowledge->new('fred');
isa_ok($x, 'AI::ExpertSystem::Simple::Knowledge');
################################################################################
t/Knowledge.t view on Meta::CPAN
################################################################################
# Check the question attribute
################################################################################
eval { $x->has_question(1); };
like($@, qr/^Knowledge->has_question\(\) takes no arguments /, 'Too many arguments');
eval { $x->set_question(1); };
like($@, qr/^Knowledge->set_question\(\) takes 2 arguments /, 'Too few arguments');
eval { $x->set_question(undef,2); };
like($@, qr/^Knowledge->set_question\(\) argument 1, \(QUESTION\) is undefined /, 'Question is undefined');
eval { $x->get_question(); };
like($@, qr/^Knowledge->set_question\(\) has not been set /, 'Question not set');
is($x->has_question(), '', 'No question has been set');
$x->set_question('to be or not to be', ('be', 'not'));
is($x->has_question(), '1', 'The question is now set');
eval { $x->set_question('fredfred', (1,2)); };
like($@, qr/^Knowledge->set_question\(\) has already been set /, 'Is already set');
################################################################################
# Check the question attribute
################################################################################
is($x->get_value(), undef, 'The value is unset');
is($x->has_question(), '1', 'The question has not been answered');
eval { $x->set_value(); };
like($@, qr/^Knowledge->set_value\(\) takes 2 argument /, 'Too few arguments');
eval { $x->set_value(1); };
like($@, qr/^Knowledge->set_value\(\) takes 2 argument /, 'Too few arguments');
eval { $x->set_value(1,2,3); };
like($@, qr/^Knowledge->set_value\(\) takes 2 argument /, 'Too many arguments');
eval { $x->set_value(undef,2); };
like($@, qr/^Knowledge->set_value\(\) argument 1, \(VALUE\) is undefined /, 'Value is undefined');
eval { $x->set_value(1,undef); };
like($@, qr/^Knowledge->set_value\(\) argument 2, \(SETTER\) is undefined /, 'Value is undefined');
eval { $x->is_value_set(1); };
like($@, qr/^Knowledge->is_value_set\(\) takes no arguments /, 'Too many arguments');
is($x->is_value_set(), '', 'Value is not set');
$x->set_value('fred', 'banana');
is($x->is_value_set(), '1', 'Value is set');
################################################################################
my $x;
eval { $x = AI::ExpertSystem::Simple::Rule->new(); };
like($@, qr/^Rule->new\(\) takes 1 argument /, 'Too few arguments');
eval { $x = AI::ExpertSystem::Simple::Rule->new(1,2); };
like($@, qr/^Rule->new\(\) takes 1 argument /, 'Too many arguments');
eval { $x = AI::ExpertSystem::Simple::Rule->new(undef); };
like($@, qr/^Rule->new\(\) argument 1 \(NAME\) is undefined /, 'Name is undefined');
$x = AI::ExpertSystem::Simple::Rule->new('fred');
isa_ok($x, 'AI::ExpertSystem::Simple::Rule');
eval { $x->name(1); };
like($@, qr/^Rule->name\(\) takes no arguments /, 'Too many arguments');
is($x->name(), 'fred', 'Checking the name');
################################################################################
# Populate the rule
################################################################################
eval { $x->add_condition(1); };
like($@, qr/^Rule->add_condition\(\) takes 2 arguments /, 'Too few arguments');
eval { $x->add_condition(1, 2, 3); };
like($@, qr/^Rule->add_condition\(\) takes 2 arguments /, 'Too many arguments');
eval { $x->add_condition(undef, 2); };
like($@, qr/^Rule->add_condition\(\) argument 1 \(NAME\) is undefined /, 'Name is undefined');
eval { $x->add_condition(1, undef); };
like($@, qr/^Rule->add_condition\(\) argument 2 \(VALUE\) is undefined /, 'Value is undefined');
$x->add_condition('a', 1);
eval { $x->add_condition('a', 1); };
like($@, qr/^Rule->add_condition\(\) has already been set /, 'Is already set');
$x->add_condition('b', 2);
eval { $x->add_action(1); };
like($@, qr/^Rule->add_action\(\) takes 2 arguments /, 'Too few arguments');
eval { $x->add_action(1, 2, 3); };
like($@, qr/^Rule->add_action\(\) takes 2 arguments /, 'Too many arguments');
eval { $x->add_action(undef, 2); };
like($@, qr/^Rule->add_action\(\) argument 1 \(NAME\) is undefined /, 'Name is undefined');
eval { $x->add_action(1, undef); };
like($@, qr/^Rule->add_action\(\) argument 2 \(VALUE\) is undefined /, 'Value is undefined');
$x->add_action('c', 3);
eval { $x->add_action('c', 3); };
like($@, qr/^Rule->add_action\(\) has already been set /, 'Is already set');
eval { $x->state(1); };
like($@, qr/^Rule->state\(\) takes no arguments /, 'Too many arguments');
is($x->state(), 'active', 'Is the rule active');
like($@, qr/^Rule->unresolved\(\) takes no arguments /, 'Too many arguments');
is(scalar($x->unresolved()), 2, 'Unresolved list');
eval { $x->given(1); };
like($@, qr/^Rule->given\(\) takes 2 arguments /, 'Too few arguments');
eval { $x->given(1, 2, 3); };
like($@, qr/^Rule->given\(\) takes 2 arguments /, 'Too many arguments');
eval { $x->given(undef, 2); };
like($@, qr/^Rule->given\(\) argument 1 \(NAME\) is undefined /, 'Name is undefined');
eval { $x->given(1, undef); };
like($@, qr/^Rule->given\(\) argument 2 \(VALUE\) is undefined /, 'Value is undefined');
is($x->given('b', 2), 'active', 'Is the rule still active');
is(scalar($x->unresolved()), 1, 'Unresolved list');
is($x->given('a', 1), 'completed', 'Is the rule now complete');
is(scalar($x->unresolved()), 0, 'Unresolved list');
################################################################################
################################################################################
# Load a file
################################################################################
eval { $x->load(); };
like($@, qr/^Simple->load\(\) takes 1 argument /, 'Too few arguments');
eval { $x->load(1,2); };
like($@, qr/^Simple->load\(\) takes 1 argument /, 'Too many arguments');
eval { $x->load(undef); };
like($@, qr/^Simple->load\(\) argument 1 \(FILENAME\) is undefined /, 'Filename is undefined');
eval { $x->load('no_test.xml'); };
like($@, qr/^Simple->load\(\) unable to use file /, 'Cant use this file');
eval { $x->load('t/empty.xml'); };
like($@, qr/^Simple->load\(\) XML parse failed: /, 'Cant use this file');
is($x->load('t/test.xml'), '1', 'File is loaded');
eval { $x->process(1); };
like($@, qr/^Simple->get_question\(\) takes no arguments /, 'Too many arguments');
my ($t, $r) = $x->get_question();
eval { $x->answer(); };
like($@, qr/^Simple->answer\(\) takes 1 argument /, 'Too few arguments');
eval { $x->answer(1,2); };
like($@, qr/^Simple->answer\(\) takes 1 argument /, 'Too many arguments');
eval { $x->answer(undef); };
like($@, qr/^Simple->answer\(\) argument 1 \(VALUE\) is undefined /, 'Value is undefined');
$x->answer('yes');
is($x->process(), 'continue', 'Carry on');
is($x->process(), 'finished', 'Thats all folks');
eval { $x->get_answer(1); };
like($@, qr/^Simple->get_answer\(\) takes no arguments /, 'Too many arguments');
is($x->get_answer(), 'You have set the goal to pretzel', 'Got the answer');
( run in 1.596 second using v1.01-cache-2.11-cpan-d80b1682f3f )