The main caveat is that I can add or lose characters depending on exact behaviour of these additional functions. (Particularly important is the behaviour of "a". I assumed that it returned 0,1 and added returns on prints but not a ?.) Here are the exact functions as I used them for my solution:

sub a {
  print @_, "\n";
  my $r = <STDIN>;
  if ($r =~ /y/i) {
    return 1;
  }
  elsif ($r =~ /n/i) {
    return 0;
  }
  else {
    print "Sorry, I don't understand that.  Please answer Y/N.\n";
    a(@_);
  }
}

sub t {
  print "What is your animal?\n";
  my $ans = <STDIN>;
  chomp($ans);
  return $ans;
}

sub i {
  my ($guessed, $user_answer) = @_;
  chomp($guessed, $user_answer);
  print "Please enter a question that would be true for a "
    . "$user_answer, but false for a $guessed:\n";
  my $ans = <STDIN>;
  chomp($ans);
  return $ans;
}

sub w {
  if (a("\nDo you want to continue?")) {
    print "\nStarting a new game.\n";
  }
  else {
    print "BYE!\n";
    exit();
  }
}
[download]

$Q{a}="golfer";
[download]

#         1         2         3         4         5         6         
+7         8         9        10        11
#123456789_123456789_123456789_123456789_123456789_123456789_123456789
+_123456789_123456789_123456789_123456789_1234567
{*q=\%Q;*q=$q{a$q{q}}while$q{q};$q{0}{a}=$q{a},$q{1}{a}=t,$q{q}=i($q{a
+},$q{1}{a})if!a"Is your animal a $q{a}?";w,redo}


# Was
#{*q=*Q;*q=$q{a$q{q}}while$q{q};$q{0}{a}=$q{a},$q{1}{a}=t,$q{q}=i($q{a
+},$q{1}{a})if!a"Is your animal a $q{a}?";w&&redo}
[download]

Nice solution, but it really gets thrown out if you pick the same two animals in alternation.

Starting a new game.
does your animal have feathers?
y
Is your animal a chicken?
n
What is your animal?
sparrow
Please enter a question that would be true for a sparrow, but false fo
+r a chicken:
is your animal smaller than your fist? 

Do you want to continue?
y

Starting a new game.
is your animal smaller than your fist?
n
Is your animal a chicken?
y

Do you want to continue?
y

Starting a new game.
Is your animal a chicken?
n
What is your animal?
sparrow
Please enter a question that would be true for a sparrow, but false fo
+r a chicken:
is your animal smaller than your fist?

Do you want to continue?
y
[download]

In fact I can never get it to filter down beyond one quesiton. Surely it's trying to do a sort and should look like:

does your animal have fur?
y
is your animal smaller than your fist?
y
is your animal a mouse?
y

Do you want to continue?
[download]

but I can't get beyond:

the last question you answered:
           true -> your last animal
           false -> computer's previous guess.
[download]

Updated: Forgot to change my datastructure from a hash of hashes to a hash of arrays. That caused the bug jarich noticed. ++!

#!/usr/local/bin/perl

my %tree = (
    'larger than a breadbox' => [
        'cat',
        'giraffe',
    ],
);

sub a {
    print 'Is your animal ', shift, "?\n";
    my $answer = <STDIN>;
    chomp $answer;
    return 1 if $answer =~ /y/i;
    return 0;
}

sub t {
    print "What is your animal?\n";
    my $answer = <STDIN>;
    chomp $answer;
    return $answer;
}

sub i {
    my ($g, $u) = @_;
    print "What is a question that is true for $u, but false for $g?\n
+";
    my $answer = <STDIN>;
    chomp $answer;
    $answer =~ s/Is your animal //;
    return $answer;
}

sub w {
    print "Do you want to continue?\n";
    my $answer = <STDIN>;
    chomp $answer;
    return 1 if $answer =~ /y/i;
    return 0;
}

#234567890#234567890#234567890#234567890#234567890#234567890#234567890
+#234567890
sub f {
($s,%t)=@_;$q=$s;do{{$v=a($q);$a=$t{$q}[$v];$q=$a,redo if$t{$a};$q=$s,
+next if a(
$a);$n=&t;$o=i($a,$n);$t{$o}=[$t{$q}[$v],$n];$t{$q}[$v]=$o;$q=$s}}whil
+e&w
}

f( 'larger than a breadbox',%tree);

__END__
[download]

------
We are the carpenters and bricklayers of the Information Age.

Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.

I can't golf it better, but I can fix a bug I've spotted. If you say your animal isn't bigger than a bread box, it guesses your animal to be "1", which isn't much fun. These are my changes:

my %tree = (
    'Is your animal larger than a breadbox' => {
        '1' => 'giraffe',
        '0' => 'cat',
    },
);              # anon hashref rather than array ref

#234567890#234567890#234567890#234567890#234567890
sub f{
($s,%t)=@_;$q=$s;do{{$v=a($q);$a=$t{$q}->{$v};$q=
$a,redo if$t{$a};$q=$s,next if a($a);$n=&t;$o=i($a
,$n);$t{$o}={0=>$t{$q}->{$v},1=>$n};$t{$q}->{$v}=
$o;$q=$s;}}while&w
}
[download]

Sorry about the extra 13 characters. ;) It's a cool program though, I've got to admit that the idea had me stumped 'til I saw yours and Tilly's answers.

jarich

update: I can't count (or rather I forgot the indexing), 13 extra characters, not 6.

It's supposed to be anon listref. I had it as anon hashref, then switched it to anon listref. Updated my original node.

------
We are the carpenters and bricklayers of the Information Age.

Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.

Heh. I found an interesting bug in mine. If you use the same question for two branches, it overwrites. This is due to the 1-D flattening of the N-D structure. *grins* I don't feel like fixing it. :-)

------
We are the carpenters and bricklayers of the Information Age.

Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.

My free subs:

sub a {
    print shift;
    my $answer = <STDIN>;
    chomp $answer;
    return 1 if $answer =~ /y/i;
    return 0;
}

sub t {
    print "What is your animal?\n";
    my $answer = <STDIN>;
    chomp $answer;
    return $answer;
}

sub i {
    my ($g, $u) = @_;
    print "What is a question that is true for $u, but false for $g?\n
+";
    my $answer = <STDIN>;
    return $answer;
}

sub w {
    print "Do you want to continue?\n";
    my $answer = <STDIN>;
    chomp $answer;
    return 1 if $answer =~ /y/i;
    return 0;
}

sub g {
    my $animal = shift;
    print "Is your animal a";
    print "n" if $animal =~ /^[aeiou]/;
    print " $animal?\n";
    my $answer = <STDIN>;
    chomp $answer;
    return 1 if $answer =~ /y/i;
    return 0;
}
[download]

My free initialization:

my @t = (
    [
        undef,undef,
        ['cat','giraffe',"Is your animal larger than a breadbox?\n"]
    ]
);
[download]

And my long-winded (281) solution:

sub r{my$t=shift;my$x=a($t->[2][2]);$t->[$x]?r($t->[$x]):return $t->[2
+][$x]}sub
n{my$t=shift;for(0,1){if($t->[2][$_]eq$b&&!$t->[$_]){$t->[$_]=[undef,u
+ndef,[$b,$
a,$q]];return 1}last if$t->[$_]&&n($t->[$_])}}while(1){$b=r($t[0]);if(
+!g($b)){$a
=t();$q=i($b,$a);n($t[0])}last if!w()}
[download]

here's the full code:

#!/usr/local/bin/perl -w
use strict;
$|=1;

# www.PerlMonks.org 140734|(Golf) The Animal Game

# ask the question passed, return true or false
sub a($) {
    my ($qu, $ans) = (shift);
    while(!$ans) { print "\n$qu?\n"; chomp ($ans = <STDIN>) }
    $ans =~ m/y/io ? 1 : 0;
};

# ask if animal is passed value, return true or false
sub g($) {
    my ($ani, $ans) = (shift);
    while(!$ans) { print "\nis animal $ani?\n"; chomp ($ans = <STDIN>)
+ }
    $ans =~ m/^y/io ? 1 : 0;
};

# ask what animal, return user input
sub t() {
    my $ans;
    while(!$ans) { print "\nwhat animal?\n"; chomp ($ans = <STDIN>) }
    $ans;
};

# get question to identify animal: 
# true for new, false for old; return question
sub i($$) {
    my ($old, $new, $qu) = (shift, shift);
    while(!$qu) {
        print "\nenter a question false for $old but true for $new:\n"
+;
        chomp ($qu = <STDIN>);
    }
    $qu;
};

# ask to continue, return true or false
sub w() { a('play') ? 1 : exit 0 };

# question/answer data structure: hash of arrays
my %q = (
    "larger than a breadbox" => ['cat', 'giraffe'],
);

no strict;
while(w){($k,$v)=each%q;$k||redo;$u=$$v[a($k)];next if(g($u));while(($
+l,$x)=each%q){next unless$$x[0] eq $u;a($l)?$y=$$x[1]:goto N;goto E i
+f(g($y))}N:$b=i($u,$c=t);$q{$b}=[$u,$c];E:}
[download]

no strict;
{
    while(w){
        # select a question
        ($k,$v)=each%q;
        # try again if no more questions (end of hash)
        $k||redo;
        # ask question, get proper animal from question hash
        $t2=$$v[a($k)];
        # guess animal, end loop if found answer
        next if(g($t2));
        # lookup keys with value[0] matching $t2
        while(($k2,$v2)=each%q){
            next unless$$v2[0] eq $t2;
            # if key exists, ask question
            # if answer negative, ask new animal
            a($k2)?$t5=$$v2[1]:goto NEW;
            goto END if(g($t5));
        }
        # else, ask new animal
NEW:
        # ask new animal
        $t4=i($t2,$t3=t);
        # add to question hash
        $q{$t4}=[$t2,$t3];
END:
    }
}
[download]

~Particle

my @q = ( 'Is your animal larger then a bread box', 
          'Is your animal taller then a car' );
my @a = ( 'dog' );
sub a {
    print shift, "?\n";
    my $a = <>;
    return 1 if $a =~ /y/i;
}

sub g {
    print 'I think your animal is a ', shift , ", am I right?\n";
    my $a = <>;
    return 1 if $a =~ /y/i;
}

sub t {
    my $q = shift;
    print "What was your animal?\n";
    my $a = <>;
    chomp $a;
    push @a , $a;
    return $a;
}

sub i {
    my ($u,$g) = @_;
    print "What is a question that is true for $u, but false for $g?\n
+";
    my $answer = <STDIN>;
    chomp $answer;
    push @q , $answer;
    return $answer;
}

sub w {
    print "Do you want to conitue?\n";
    my $a = <>;
    if ($a =~ /n/i) {
        die "Thanks for playing\n";
    };
    do_it();
}



sub do_it{
for$s(@a){$g=$s;for$q(@q){if(a($q)){$g=$r{$q}||$s}}
if(g($g)){w()}else{$t=t();$i=i($t,$g);$r{$i}=$t;do_it()}}}
&do_it();

1;
[download]