#!/usr/bin/perl -w
use strict;

# Create a descriptive string of what a structure actually is.
# This works for structures described by the RE ([AH]o)*[S],
# where A means array, H means hash and S means scalar
# (and everything ends with a scalar obviously, or a class
# or a code reference - a case I don't cover).

my %letter = (
  ARRAY  => "A",
  HASH   => "H",
  SCALAR => "S",
  REF    => "r",
);

sub describe {
  my ($struct) = @_;

  my $element;
  my $result;

  if (ref $struct) {
    #print "Got",ref $struct;
    if (defined $letter{ref $struct}) {
      # Yehaaw, we know it :
      $result = $letter{ref $struct};

      if (ref $struct eq "REF") {
        $result = $result . describe( $$struct );
      }elsif (ref $struct eq "ARRAY") {
        if (@$struct) {
          $element = describe($$struct[0]);
          foreach (@$struct) {
            if (describe($_) ne $element) {
              $element = "[]";
              last;
            };
          };
        } else {
          $element = "?";
        };
        $result .= "o$element";
      } elsif (ref $struct eq "HASH") {
        my @keys = keys (%$struct);
        if (@keys) {
          $element = describe($struct->{$keys[0]});
          foreach (@keys) {
            if (describe($struct->{$_}) ne $element) {
              $element = "{}";
              last;
            };
          };
        } else {
          element = "?";
        };
        $result .= "o$element";
      } elsif (ref $struct eq "SCALAR") {
        $result = "oS";
      };
    } else {
      $result = "?";
    };
  } else {
    $result = "S";
  };

  return $result;
};

my $foo = "bar";
my $bar = [qw(foo bar baz)];
my $baz = {foo => "bar", baz => "quux"};
my $x = [
  {foo => "bar", baz => "quux"},
  {foo => "bar", baz => "quux"},
  {foo => "bar", baz => "quux"},
];

my $y = {
  foo => ["bar","quux"],
  baz => ["quux","bar"],
};

print q("foo" -> ),describe("foo"),"\n";
print q(\\$foo -> ),describe(\$foo),"\n";
print q($bar -> ),describe($bar),"\n";
print q(\\$bar -> ),describe(\$bar),"\n";
print q($baz -> ),describe($baz),"\n";
print q(\\$baz -> ),describe(\$baz),"\n";
print q($x -> ),describe($x),"\n";
print q(\\$x -> ),describe(\$x),"\n";
print q($y -> ),describe($y),"\n";
print q(\\$y -> ),describe(\$y),"\n";

##</code><code>##

perl -MHTTP::Daemon -MHTTP::Response -MLWP::Simple -e ' ;    # The  
$d = new HTTP::Daemon and fork and getprint $d->url and exit;#spider
($c = $d->accept())->get_request(); $c->send_response( new   #in the
HTTP::Response(200,$_,$_,qq(Just another Perl hacker\n))); ' #  web