Checking whether two variables have the same structure

[Corion]

Yesterday in the Chatterbox, Ovid asked for a quick solution to see if two references $r1 and $r2 pointed to the same kind of structure, that is, to a HoH or AoH or whatever. My first hack at a solution was to suggest to useData::Dumper and to throw away all actual data, if the remaining strings were equal, then $r1 and $r2 surely pointed to the same kind of structure.

This solution has many fallacies, as both $r1 and $r2 might point to arrays of different size, but the kind of structure would still be considered the same by me.

The second solution I suggested was to compute the "signature" for each structure, that is, to compute a string that described the structure. For example, a reference to an array which contains scalars would have the signature rAoS, and an array which contains references to hashes would have the signature AoH. This kind of signature only makes sense when all elements of a container (be it a hash or an array) are of the same type, but if they aren't, there is not much sense in talking of "structure" anyway.

After having computed this signature, it's just a matter of comparing the two signatures as strings to see whether the structures have the same kind.

If you have interesting points to make or an alternative approach that handles classes and code or is more robust/more elegant, I invite you to share !

#!/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";

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