Here's a different take that I'm sure is has a couple gotchas. It's definitely rough around the edges but it's very flexible. Will need to add negations.
#!/usr/bin/perl -w
use strict;
package AI::Thingy;
use overload (
'""' => \&stringify,
);
my $THING_ID = 0;
use Data::Dumper;
our (%OBJS) = ();
%OBJS = ();
our $VERSION = '0.01';
our @EXPORT = qw (is has assert);
our @EXPORT_OK = qw();
our @EXPORT_FAIL = qw();
########################################################
sub import {
no strict 'refs';
my $used_name = shift ; # Remove the Module name.
my ($Version) = grep { m/^\d[\d.]*$/} @_;
my @ex = grep { !m/^(\d[\d\.]+)$/} @_;
die "Insufficient or missing \$VERSION: $VERSION, $Version require
+d." if $Version && $VERSION <= $Version;
push @ex, @EXPORT ;
my %EXP = map {($_,'mKay')} @EXPORT,@EXPORT_OK;
$EXP{$_} = 'Bad' for @EXPORT_FAIL;
my $that_pack = caller();
foreach (@ex){
next if m/^\d[\d\.]+$/;
die "Denied. Can't export $_" if defined $EXP{$_} && $EXP{$_}
+eq 'Bad';
unless (defined $EXP{$_} && $EXP{$_} eq 'mKay') {
# Lets make some accessors...
die "Can't export unknown symbol $_" if $_ =~/^[\@\$\*\%]/
+;
my $att = $_;
*{__PACKAGE__.'::'.$att} = *{$that_pack.'::'.$att} = sub {
my ($self,$what) = @_;
return defined $what ? $self->{$att}{$what} : keys %{$self->{$att
+}};
};
}
m/^([\@\$\*\&\%]?)(\w+)/;
my ($t,$v) = ($1,$2);
$t = '&' unless $t;
*{$that_pack.'::'.$v} = $t eq '@' && \@{$v} || $t eq '%' && \%
+{$v} ||
$t eq '&' && \&{$v} || $t eq '$' && \${$v} ||
$t eq '*' && \*{$v} || \*{$_};
}
}
sub Objects {
my ($Cl,$type) = @_;
my @objs = map { $OBJS{$_}->{'__IDENTITY'} } sort keys %OBJS;
return defined $type ? grep{ $OBJS{$_}->{is}{$type} } @objs : @obj
+s;
}
########################################################
sub new {
my $class = shift;
my $self = { has=>{}, is=>{} };
my $name = shift;
$self->{__THINGID} = $THING_ID++;
$self->{NAME} = $name || $self->{__THINGID};
bless($self, $class);
$self->assert(@_);
return $self;
}
########################################################
sub has($$) {
my $self = shift;
my $what = shift;
return sort keys %{$self->{has}} unless defined $what;
return $self->{has}{$what} if exists $self->{has}{$what};
# Else look for it.
my %seen = ();
_has(\%seen,$what, keys %{ $self->{has} } );
}
########################################################
sub _has{
my ($seen,$target,@has) = @_;
my $val;
foreach my $h (@has){
$seen->{$h} ? next : $seen->{$h}++;
return $OBJS{$h}{is}->{$target} if exists $OBJS{$h}{is}->{$tar
+get};
$val = _is($seen,$target,keys %{$OBJS{$h}->{is} }
);
last if $val;
}
return $val;
}
########################################################
sub _is {
my ($seen,$target,@is) = @_;
foreach my $h (@is){
$seen->{$h} ? next : $seen->{$h}++;
return $OBJS{$h}{is}->{$target} if exists $OBJS{$h}{is}->{$tar
+get};
_has($seen,$target,keys %{$OBJS{$h}->{__IDENTITY}->{has} });
}
return;
}
########################################################
sub is($$) {
my $self = shift;
my $what = shift;
return $what ? $OBJS{$self}{is}->{$what} : sort keys %{$OBJS{$self
+}{is}};
}
########################################################
sub assert{
my $self = shift;
my %args = (
has=> undef,
is => undef,
@_,
);
foreach my $prop (keys %args){
if ($prop eq 'is'){
$OBJS{$self}->{'__IDENTITY'} = $self;
foreach my $k (@{$args{$prop}}){
$OBJS{$self}->{is}{$k}++;
}
}else{
foreach my $k (@{$args{$prop}}){
$self->{$prop}{$k}++;
}
}
}
}
sub stringify{
my $self = shift;
return $self->{NAME};
}
package main;
AI::Thingy->import qw(has is knows wants); # Make these accessors
my %things = (
merlyn =>{
has=>[ 'gold' ],
is=>[ 'person', 'author'],
knows=>['perl', 'kudra'],
},
shotgunefx=>{
has=>['nothing'],
is=>['person', 'depraved'],
},
ovid =>{
is=>[ 'person'],
has=>[ 'pocketLint', 'cheapWhiskey','diamonds'
+ ],
knows=>['kungfu', 'munitions'],
},
diamonds=>{
is=> ['gem'],
},
gem=>{
is=>['valuable'],
},
kungfu=>{
is=>['power', 'valuable'],
},
power=>{
is=>['valuable']
},
kudra =>{
is=>[ 'person'],
has=> [ 'dominationfund'],
knows=>['ovid'],
},
gold=> {
is=>[ 'thing','currency'],
},
currency=>{
is=>['valuable'],
},
dominationfund=>{
is=>['thing'],
},
cheapWhiskey=>{
is=>['thing'],
},
pocketLint =>{
is=>['thing'],
},
);
foreach my $p (keys %things){
$things{$p} = AI::Thingy->new($p, %{$things{$p}} );
}
my @people = AI::Thingy->Objects('person'); # Retrieve all the peop
+le
# For is() && has() will try and do taxonomy. ovid has diamonds, diamo
+nds are gems, gems are valuable.
foreach my $person ( @people ){
if ( has($person,'valuable') ){
print "$person has valuables\n";
}else{
print "$person is a thief\n";
# Rob anyone who is rich and we don't know.
print map {"\twill fleece $_\n"}
grep {"$_" ne "$person" && has($_,'valuable') && !know
+s($person,$_) }
@people
}
}
-Lee
"To be civilized is to deny one's nature."