AI-ExpertSystem-Advanced
view release on metacpan or search on metacpan
initial_facts => ['I'],
verbose => 1);
By default this is turned off. If you want to know what happens
behind the scenes turn this on.
Everything that needs to be debugged will be passed to the debug()
method of your viewer.
viewer
Is the object AI::ExpertSystem::Advanced will be using for printing
what is happening and for interacting with the user (such as asking
the asked_facts).
This is practical if you want to use a viewer object that is not
provided by AI::ExpertSystem::Advanced::Viewer::Factory.
viewer_class
Is the the class name of the viewer.
You can decide to use the viewers
inc/Module/Install.pm view on Meta::CPAN
}
sub _write {
local *FH;
if ( $] >= 5.006 ) {
open( FH, '>', $_[0] ) or die "open($_[0]): $!";
} else {
open( FH, "> $_[0]" ) or die "open($_[0]): $!";
}
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub _version ($) {
my $s = shift || 0;
my $d =()= $s =~ /(\.)/g;
if ( $d >= 2 ) {
# Normalise multipart versions
$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
}
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map {
$_ . '0' x (3 - length $_)
} $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
inc/Module/Install/Fetch.pm view on Meta::CPAN
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
$args{url} = $args{ftp_url}
or (warn("LWP support unavailable!\n"), return);
($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
}
$|++;
print "Fetching '$file' from $host... ";
unless (eval { require Socket; Socket::inet_aton($host) }) {
warn "'$host' resolve failed!\n";
return;
}
return unless $scheme eq 'ftp' or $scheme eq 'http';
require Cwd;
my $dir = Cwd::getcwd();
inc/Module/Install/Fetch.pm view on Meta::CPAN
}
my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
}
unless (-f $file) {
warn "Fetching failed: $@\n";
chdir $dir; return;
}
return if exists $args{size} and -s $file != $args{size};
system($args{run}) if exists $args{run};
unlink($file) if $args{remove};
print(((!exists $args{check_for} or -e $args{check_for})
? "done!" : "failed! ($!)"), "\n");
chdir $dir; return !$?;
}
1;
inc/Module/Install/Makefile.pm view on Meta::CPAN
$makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
#$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
# Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
$makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
# XXX - This is currently unused; not sure if it breaks other MM-users
# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
print MAKEFILE "$preamble$makefile$postamble" or die $!;
close MAKEFILE or die $!;
1;
}
sub preamble {
my ($self, $text) = @_;
$self->{preamble} = $text . $self->{preamble} if defined $text;
$self->{preamble};
}
inc/Module/Install/Metadata.pm view on Meta::CPAN
my $version = shift @requires;
$self->test_requires( $module => $version );
}
}
# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
# numbers (eg, 5.006001 or 5.008009).
# Also, convert double-part versions (eg, 5.8)
sub _perl_version {
my $v = $_[-1];
$v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
$v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
$v =~ s/(\.\d\d\d)000$/$1/;
$v =~ s/_.+$//;
if ( ref($v) ) {
# Numify
$v = $v + 0;
}
return $v;
}
inc/Module/Install/Metadata.pm view on Meta::CPAN
# We need YAML::Tiny to write the MYMETA.yml file
unless ( eval { require YAML::Tiny; 1; } ) {
return 1;
}
# Generate the data
my $meta = $self->_write_mymeta_data or return 1;
# Save as the MYMETA.yml file
print "Writing MYMETA.yml\n";
YAML::Tiny::DumpFile('MYMETA.yml', $meta);
}
sub write_mymeta_json {
my $self = shift;
# We need JSON to write the MYMETA.json file
unless ( eval { require JSON; 1; } ) {
return 1;
}
# Generate the data
my $meta = $self->_write_mymeta_data or return 1;
# Save as the MYMETA.yml file
print "Writing MYMETA.json\n";
Module::Install::_write(
'MYMETA.json',
JSON->new->pretty(1)->canonical->encode($meta),
);
}
sub _write_mymeta_data {
my $self = shift;
# If there's no existing META.yml there is nothing we can do
inc/Module/Install/Win32.pm view on Meta::CPAN
$self->load('get_file');
require Config;
return unless (
$^O eq 'MSWin32' and
$Config::Config{make} and
$Config::Config{make} =~ /^nmake\b/i and
! $self->can_run('nmake')
);
print "The required 'nmake' executable not found, fetching it...\n";
require File::Basename;
my $rv = $self->get_file(
url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
local_dir => File::Basename::dirname($^X),
size => 51928,
run => 'Nmake15.exe /o > nul',
check_for => 'Nmake.exe',
remove => 1,
lib/AI/ExpertSystem/Advanced.pm view on Meta::CPAN
of your L<viewer>.
=cut
has 'verbose' => (
is => 'rw',
isa => 'Bool',
default => 0);
=item B<viewer>
Is the object L<AI::ExpertSystem::Advanced> will be using for printing what is
happening and for interacting with the user (such as asking the
L<asked_facts>).
This is practical if you want to use a viewer object that is not provided by
L<AI::ExpertSystem::Advanced::Viewer::Factory>.
=cut
has 'viewer' => (
is => 'rw',
isa => 'AI::ExpertSystem::Advanced::Viewer::Base');
lib/AI/ExpertSystem/Advanced.pm view on Meta::CPAN
$rule_no, 'causes_pending');
if (defined $causes_total and defined $causes_pending) {
# No more pending causes for this rule, lets shoot it
if ($causes_pending-1 le 0) {
my $last_rule = $self->remove_last_visited_rule();
if ($last_rule eq $rule_no) {
$self->{'viewer'}->debug("Going to shoot $last_rule")
if $self->{'debug'};
$self->shoot($last_rule, 'backward');
} else {
$self->{'viewer'}->print_error(
"Seems the rule ($rule_no) of goal " .
"$goal is not the same as the last " .
"visited rule ($last_rule)");
$more_goals = 0;
next WAIT_FOR_MORE_GOALS;
}
} else {
$self->{'visited_rules'}->update($rule_no,
{
causes_pending => $causes_pending-1
lib/AI/ExpertSystem/Advanced.pm view on Meta::CPAN
will be asked to the user. For example, we know that that the patient has a
headache but that doesn't give us any positive answer, what if the patient has
flu or another disease? Then a set of these I<related> symptons will be asked
to the user.
=cut
sub mixed {
my ($self) = @_;
if (!$self->forward()) {
$self->{'viewer'}->print_error("The first execution of forward failed");
return 0;
}
use Data::Dumper;
while(1) {
# We are satisfied if only one inference fact is positive (eg, means we
# got to our result)
while(my $fact = $self->{'inference_facts'}->iterate) {
my $sign = $self->{'inference_facts'}->get_value($fact, 'sign');
lib/AI/ExpertSystem/Advanced.pm view on Meta::CPAN
# now each intuitive fact will be a goal
while(my $fact = $intuitive_facts->iterate) {
$self->{'goals_to_check_dict'}->append(
$fact,
{
name => $fact,
sign => $intuitive_facts->get_value($fact, 'sign')
});
$self->{'goals_to_check_dict'}->populate_iterable_array();
print "Running backward for $fact\n";
if (!$self->backward()) {
$self->{'viewer'}->debug("Backward exited");
return 1;
}
# Now we have inference facts, anything positive?
$self->{'inference_facts'}->populate_iterable_array();
while(my $inference_fact = $self->{'inference_facts'}->iterate) {
my $sign = $self->{'inference_facts'}->get_value(
$inference_fact, 'sign');
if ($sign eq FACT_SIGN_POSITIVE) {
$self->{'viewer'}->print(
"Done, a positive inference fact found"
);
return 1;
}
}
}
$self->forward();
}
}
lib/AI/ExpertSystem/Advanced.pm view on Meta::CPAN
If C<$return> is defined (eg, it got any parameter) then the result wont be
passed to the L<viewer>, instead it will be returned as a string.
=cut
sub summary {
my ($self, $return) = @_;
# any facts we found via inference?
if (scalar @{$self->{'inference_facts'}->{'stack'}} eq 0) {
$self->{'viewer'}->print_error("No inference was possible");
} else {
my $summary = {};
# How the rules started being shot?
my $order = 1;
# So, what rules we shot?
foreach my $shot_rule (sort(keys %{$self->{'shot_rules'}})) {
$summary->{'rules'}->{$shot_rule} = {
order => $order,
};
$order++;
lib/AI/ExpertSystem/Advanced/Viewer/Base.pm view on Meta::CPAN
use Moose;
our $VERSION = '0.02';
use constant NO_ABSTRACT_CLASS_MSG =>
qq#Sorry, you can't call the abstract class!#;
=head2 B<debug($msg)>
Will be used to debug any task done by L<AI::ExpertSystem::Advanced>. It only
receives one parameter that is the message to print.
=cut
sub debug {
confess NO_ABSTRACT_CLASS_MSG;
}
=head2 B<print($msg)>
Will be used to print anything that is not a debug messages. It only receives
one parameter that is the message to print.
=cut
sub print {
confess NO_ABSTRACT_CLASS_MSG;
}
=head2 B<print_error($msg)>
Will be used to print any error of L<AI::ExpertSystem::Advanced>. It only
receives one parameter that is the message to print.
=cut
sub print_error {
confess NO_ABSTRACT_CLASS_MSG;
}
=head2 B<ask($message, @options)>
Will be used to ask the user for some information. It will receive a string,
the question to ask and an array of all the possible options.
Please return only one option and this should be any of the ones listed in
C<@options> cause otherwise L<AI::ExpertSystem::Advanced> will die.
lib/AI/ExpertSystem/Advanced/Viewer/Terminal.pm view on Meta::CPAN
=cut
has 'readline' => (
is => 'ro',
isa => 'Term::ReadLine');
=head1 Methods
=head2 B<debug($msg)>
Basically just prints the given C<$msg> but prepends the "DEBUG" string to it.
=cut
sub debug {
my ($self, $msg) = @_;
print "DEBUG: $msg\n";
}
=head2 B<print($msg)>
Simply prints the given C<$msg>.
=cut
sub print {
my ($self, $msg) = @_;
print "$msg\n";
}
=head2 B<print_error($msg)>
Will prepend the "ERROR:" word to the given message and then will call
C<print()>.
=cut
sub print_error {
my ($self, $msg) = @_;
$self->print("ERROR: $msg");
}
=head2 B<ask($message, @options)>
Will be used to ask the user for some information. It will receive a string,
the question to ask and an array of all the possible options.
=cut
sub ask {
my ($self, $msg, $options) = @_;
lib/AI/ExpertSystem/Advanced/Viewer/Terminal.pm view on Meta::CPAN
}
=head2 B<explain($yaml_summary)>
Explains what happened.
=cut
sub explain {
my ($self, $summary) = @_;
print $summary;
}
# Called when the object is created
sub BUILD {
my ($self) = @_;
$self->{'readline'} = Term::ReadLine->new('questions');
}
( run in 0.739 second using v1.01-cache-2.11-cpan-de7293f3b23 )