#!perl -w
# Code for Puzzle Pres - Ottawa.Pm 13 Mar 2003
@housecolour =qw(blue green red white yellow);
@nationality =qw(Brit Dane German Norwegian Swede);
@beverage    =qw(beer coffee milk tea water);
@smoke       =qw(BlueM Dunhill PaulMaul Prince Blend);
@pet         =qw(cat bird fish horse dog);

my @pers= ({hp=>1}, {hp=>2}, {hp=>3}, {hp=>4}, {hp=>5});

for (@nationality) {
    $pers[0]->{nat}= $_;
    unless (verify(@pers)) { $pers[0]->{nat}= undef; next }
for (@nationality) {
    $pers[1]->{nat}= $_;
    unless (verify(@pers)) { $pers[1]->{nat}= undef; next }
for (@nationality) {
    $pers[2]->{nat}= $_;
    unless (verify(@pers)) { $pers[2]->{nat}= undef; next }
for (@nationality) {
    $pers[3]->{nat}= $_;
    unless (verify(@pers)) { $pers[3]->{nat}= undef; next }
for (@nationality) {
    $pers[4]->{nat}= $_;
    unless (verify(@pers)) { $pers[4]->{nat}= undef; next }

for (@housecolour) {
    $pers[0]->{hc}= $_;
    unless (verify(@pers)) { $pers[0]->{hc}= undef; next }
for (@housecolour) {
    $pers[1]->{hc}= $_;
    unless (verify(@pers)) { $pers[1]->{hc}= undef; next }
for (@housecolour) {
    $pers[2]->{hc}= $_;
    unless (verify(@pers)) { $pers[2]->{hc}= undef; next }
for (@housecolour) {
    $pers[3]->{hc}= $_;
    unless (verify(@pers)) { $pers[3]->{hc}= undef; next }
for (@housecolour) {
    $pers[4]->{hc}= $_;
    unless (verify(@pers)) { $pers[4]->{hc}= undef; next }

for (@beverage) {
    $pers[0]->{bev}= $_;
    unless (verify(@pers)) { $pers[0]->{bev}= undef; next }
for (@beverage) {
    $pers[1]->{bev}= $_;
    unless (verify(@pers)) { $pers[1]->{bev}= undef; next }
for (@beverage) {
    $pers[2]->{bev}= $_;
    unless (verify(@pers)) { $pers[2]->{bev}= undef; next }
for (@beverage) {
    $pers[3]->{bev}= $_;
    unless (verify(@pers)) { $pers[3]->{bev}= undef; next }
for (@beverage) {
    $pers[4]->{bev}= $_;
    unless (verify(@pers)) { $pers[4]->{bev}= undef; next }

for (@smoke) {
    $pers[0]->{smo}= $_;
    unless (verify(@pers)) { $pers[0]->{smo}= undef; next }
for (@smoke) {
    $pers[1]->{smo}= $_;
    unless (verify(@pers)) { $pers[1]->{smo}= undef; next }
for (@smoke) {
    $pers[2]->{smo}= $_;
    unless (verify(@pers)) { $pers[2]->{smo}= undef; next }
for (@smoke) {
    $pers[3]->{smo}= $_;
    unless (verify(@pers)) { $pers[3]->{smo}= undef; next }
for (@smoke) {
    $pers[4]->{smo}= $_;
    unless (verify(@pers)) { $pers[4]->{smo}= undef; next }

for (@pet) {
    $pers[0]->{pet}= $_;
    unless (verify(@pers)) { $pers[0]->{pet}= undef; next }
for (@pet) {
    $pers[1]->{pet}= $_;
    unless (verify(@pers)) { $pers[1]->{pet}= undef; next }
for (@pet) {
    $pers[2]->{pet}= $_;
    unless (verify(@pers)) { $pers[2]->{pet}= undef; next }
for (@pet) {
    $pers[3]->{pet}= $_;
    unless (verify(@pers)) { $pers[3]->{pet}= undef; next }
for (@pet) {
    $pers[4]->{pet}= $_;
    unless (verify(@pers)) { $pers[4]->{pet}= undef; next }

      my $p2 = getpers(\@pers, "pet", "fish");
      print $p2->{"nat"}," has fish\n";
      exit 0;

    $pers[4]->{pet}= undef; }
    $pers[3]->{pet}= undef; }
    $pers[2]->{pet}= undef; }
    $pers[1]->{pet}= undef; }
    $pers[0]->{pet}= undef; }

    $pers[4]->{smo}= undef; }
    $pers[3]->{smo}= undef; }
    $pers[2]->{smo}= undef; }
    $pers[1]->{smo}= undef; }
    $pers[0]->{smo}= undef; }

    $pers[4]->{bev}= undef; }
    $pers[3]->{bev}= undef; }
    $pers[2]->{bev}= undef; }
    $pers[1]->{bev}= undef; }
    $pers[0]->{bev}= undef; }

    $pers[4]->{hc} = undef; }
    $pers[3]->{hc} = undef; }
    $pers[2]->{hc} = undef; }
    $pers[1]->{hc} = undef; }
    $pers[0]->{hc} = undef; }

    $pers[4]->{nat}= undef; }
    $pers[3]->{nat}= undef; }
    $pers[2]->{nat}= undef; }
    $pers[1]->{nat}= undef; }
    $pers[0]->{nat}= undef; }
{ use Data::Dumper ; print Dumper(@pers); die};

sub verify
{
    my @pers= @_;

    for my $cat qw(hp hc nat bev smo pet) {
        my %verif;
        for my $pers (@pers) {
            next unless $pers->{$cat};
            return 0 if $verif{$pers->{$cat}};
            $verif{$pers->{$cat}}=1;
        }
    }

#   1. The Brit lives in a red house. 
    { my $p = getpers(\@pers, "nat", "Brit");
      if ($p && $p->{hc} ) {
          return 0 unless $p->{hc} eq "red";
    } }
#   2. The Swede keeps dogs as pets. 
    { my $p = getpers(\@pers, "nat", "Swede");
      if ($p && $p->{pet} ) {
          return 0 unless $p->{pet} eq "dog";
    } }
#   3. The Dane drinks tea. 
    { my $p = getpers(\@pers, "nat", "Dane");
      if ($p && $p->{bev} ) {
          return 0 unless $p->{bev} eq "tea";
    } }
#   4. The green house is on the left of the white house (next to it). 
    { my $p1 = getpers(\@pers, "hc", "green");
      my $p2 = getpers(\@pers, "hc", "white");
      if ($p1 && $p2 && $p1->{hp} && $p2->{hp} ) {
          return 0 unless ($p2->{hp} - $p1->{hp} ==-1);
#         return 0 unless abs($p2->{hp} - $p1->{hp}) ==1;
    } }
#   5. The green house owner drinks coffee. 
    { my $p = getpers(\@pers, "hc", "green");
      if ($p && $p->{bev} ) {
          return 0 unless $p->{bev} eq "coffee";
    } }
#   6. The person who smokes Pall Mall rears birds. 
    { my $p = getpers(\@pers, "smo", "PaulMaul");
      if ($p && $p->{pet} ) {
          return 0 unless $p->{pet} eq "bird";
    } }
#   7. The owner of the yellow house smokes Dunhill. 
    { my $p = getpers(\@pers, "hc", "yellow");
      if ($p && $p->{smo} ) {
          return 0 unless $p->{smo} eq "Dunhill";
    } }
#   8. The man living in the house right in the center drinks milk. 
    { my $p = getpers(\@pers, "hp", "3");
      if ($p && $p->{bev} ) {
          return 0 unless $p->{bev} eq "milk";
    } }
#   9. The Norwegian lives in the first house. 
    { my $p = getpers(\@pers, "nat", "Norwegian");
      if ($p && $p->{hp} ) {
          return 0 unless $p->{hp} eq "1";
    } }
#  10. The man who smokes blend lives next to the one who keeps cats. 
    { my $p1 = getpers(\@pers, "smo", "Blend");
      my $p2 = getpers(\@pers, "pet", "cat");
      if ($p1 && $p2 && $p1->{hp} && $p2->{hp} ) {
          return 0 unless ( abs($p2->{hp} - $p1->{hp}) ==1);
    } }
#  11. The man who keeps horses lives next to the man who smokes Dunhill. 
    { my $p1 = getpers(\@pers, "smo", "Dunhill");
      my $p2 = getpers(\@pers, "pet", "horse");
      if ($p1 && $p2 && $p1->{hp} && $p2->{hp} ) {
          return 0 unless ( abs($p2->{hp} - $p1->{hp}) ==1);
    } }
#  12. The owner who smokes Blue Master drinks beer. 
    { my $p = getpers(\@pers, "smo", "BlueM");
      if ($p && $p->{bev} ) {
          return 0 unless $p->{bev} eq "beer";
    } }
#  13. The German smokes Prince. 
    { my $p = getpers(\@pers, "nat", "German");
      if ($p && $p->{smo} ) {
          return 0 unless $p->{smo} eq "Prince";
    } }
#  14. The Norwegian lives next to the blue house. 
    { my $p1 = getpers(\@pers, "nat", "Norwegian");
      my $p2 = getpers(\@pers, "hc", "blue");
      if ($p1 && $p2 && $p1->{hp} && $p2->{hp} ) {
          return 0 unless ( abs($p2->{hp} - $p1->{hp}) ==1);
    } }
#  15. The man who smokes blend has a neighbor who drinks water. 
    { my $p1 = getpers(\@pers, "smo", "Blend");
      my $p2 = getpers(\@pers, "bev", "water");
      if ($p1 && $p2 && $p1->{hp} && $p2->{hp} ) {
          return 0 unless ( abs($p2->{hp} - $p1->{hp}) ==1);
    } }

    return 1;
}

sub getpers {
    my @pers = @{shift()};
    my $cat  = shift;
    my $val  = shift;

    for my $pers (@pers) {
        next unless $pers->{$cat};
        return $pers if $pers->{$cat} eq $val;
    }
    return undef;
}