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

t/Goal.t  view on Meta::CPAN


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

t/Goal.t  view on Meta::CPAN

################################################################################
# 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');

t/Rule.t  view on Meta::CPAN

################################################################################

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');

t/Rule.t  view on Meta::CPAN

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');

################################################################################

t/Simple.t  view on Meta::CPAN

################################################################################
# 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); };

t/Simple.t  view on Meta::CPAN

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 2.699 seconds using v1.01-cache-2.11-cpan-d80b1682f3f )