File Coverage

lib/AI/Prolog/TermList.pm
Criterion Covered Total %
statement 70 72 97.2
branch 10 12 83.3
condition 4 6 66.6
subroutine 18 18 100.0
pod 0 6 0.0
total 102 114 89.4


line stmt bran cond sub pod time code
1             package AI::Prolog::TermList;
2             $REVISION = '$Id: TermList.pm,v 1.11 2005/08/06 23:28:40 ovid Exp $';
3              
4             $VERSION = 0.03;
5              
6 13     13   40043 use strict;
  13         30  
  13         478  
7 13     13   72 use warnings;
  13         24  
  13         401  
8 13     13   63 use Carp qw( croak confess );
  13         21  
  13         861  
9              
10 13     13   2434 use Hash::Util 'lock_keys';
  13         6034  
  13         107  
11              
12 13     13   2757 use aliased 'AI::Prolog::Term';
  13         1540  
  13         89  
13 13     13   8015 use aliased 'AI::Prolog::Term::Number';
  13         27  
  13         59  
14 13     13   10565 use aliased 'AI::Prolog::Parser';
  13         27  
  13         56  
15 13     13   2312 use aliased 'AI::Prolog::TermList::Clause';
  13         30  
  13         53  
16 13     13   1106 use aliased 'AI::Prolog::TermList::Primitive';
  13         26  
  13         64  
17              
18             sub new {
19              
20             #my ($proto, $parser, $nexttermlist, $definertermlist) = @_;
21 1945     1945 0 2931 my $proto = shift;
22 1945   66     6504 my $class = ref $proto || $proto; # yes, I know what I'm doing
23 1945 100 66     5122 return _new_from_term( $class, @_ ) if 1 == @_ && $_[0]->isa(Term);
24 1846 100       4210 return _new_from_term_and_next( $class, @_ ) if 2 == @_;
25 1291 50       2324 if (@_) {
26 0         0 croak "Unknown arguments to TermList->new: @_";
27             }
28 1291         17311 my $self = bless {
29             term => undef,
30             next => undef,
31             next_clause =>
32             undef, # serves two purposes: either links clauses in database
33             # or points to defining clause for goals
34             is_builtin => undef,
35              
36             varname => undef,
37             ID => undef,
38             _results => undef,
39             } => $class;
40 1291         3954 lock_keys %$self;
41 1291         12077 return $self;
42             }
43              
44             sub _new_from_term {
45 654     654   927 my ( $class, $term ) = @_;
46 654         1525 my $self = $class->new;
47 654         1121 $self->{term} = $term;
48 654         1489 return $self;
49             }
50              
51             sub _new_from_term_and_next {
52 555     555   910 my ( $class, $term, $next ) = @_;
53 555         1279 my $self = $class->_new_from_term($term);
54 555         862 $self->{next} = $next;
55 555         1892 return $self;
56             }
57              
58 928     928 0 2399 sub term { shift->{term} }
59              
60             sub next {
61 503     503 0 602 my $self = shift;
62 503 100       1033 if (@_) {
63 59         89 $self->{next} = shift;
64 59         125 return $self;
65             }
66 444         1334 return $self->{next};
67             }
68              
69             sub next_clause {
70 242     242 0 357 my $self = shift;
71 242 100       717 if (@_) {
72              
73             # XXX debug
74 190         243 my $next_clause = shift;
75 13     13   6290 no warnings 'uninitialized';
  13         22  
  13         4513  
76 190 50       626 if ( $next_clause eq $self ) {
77 0         0 confess("Trying to assign a termlist as its own successor");
78             }
79 190         306 $self->{next_clause} = $next_clause;
80 190         712 return $self;
81             }
82 52         197 return $self->{next_clause};
83             }
84              
85             sub to_string {
86 5     5 0 26 my $self = shift;
87 5         11 my $indent = "\n\t";
88 5         23 my $to_string = $indent . $self->term->to_string;
89              
90             #my $to_string = "[" . $self->term->to_string;
91 5         33 my $tl = $self->next;
92 5         19 while ($tl) {
93 1         5 $to_string .= ",$indent" . $tl->term->to_string;
94 1         4 $tl = $tl->next;
95             }
96 5         32 return $to_string;
97             }
98              
99             sub resolve { # a.k.a. lookup_in
100 108     108 0 1629 my ( $self, $kb ) = @_;
101 108         432 my $predicate = $self->{term}->predicate;
102 108         420 $self->next_clause( $kb->get($predicate) );
103             }
104              
105             1;
106              
107             __END__