|
Corion has asked for the wisdom of the Perl Monks concerning the following question:
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
|
Re: Checking whether two variables have the same structure
by broquaint (Abbot) on Apr 09, 2002 at 16:43 UTC
|
Here's a rather more simple (but no less lengthy ;-) attempt at creating a data structure signature.
package Data::AsString;
require Carp;
use strict;
use warnings;
use overload q("") => sub { shift->as_string() };
sub new {
my $class = shift;
my $self = {};
$self->{struct} = shift;
$self->{info} = { depth => 0 };
return bless $self, $class;
}
sub as_string {
my $self = shift;
$self->{'ref'} = $self->_traverse($self->{struct});
$self->{string} = $self->_collapse_info();
return $self->{string};
}
sub _traverse {
my $self = shift;
my $ds = shift;
my @values = ();
if(ref($ds) eq 'HASH') {
@values = values %$ds;
} elsif(ref($ds) eq 'ARRAY') {
@values = @$ds;
} else {
Carp::croak("can't iterate through a ".ref($ds));
}
foreach my $el (@values) {
if(ref($el) eq 'HASH' or ref($el) eq 'ARRAY') {
my $key = "#".$self->{info}->{depth};
push @{$self->{info}->{$key}}, ref($el);
$self->{info}->{depth}++;
push @{$self->{info}->{$key}}, $self->_traverse($el);
$self->{info}->{depth}--;
}
}
return ref $ds;
}
sub _collapse_info {
my $self = shift;
my $str = substr($self->{'ref'}, 0, 1);
for my $lvl (sort grep /^#\d+/, keys %{$self->{info}}) {
my %uniq = ();
$uniq{$_}++ for @{$self->{info}->{$lvl}};
my @type = keys %uniq;
if(@type > 1) {
Carp::carp("data is not homogeneous at depth $lvl");
$str .= '['.join("o", map { substr($_, 0, 1) } @type).']';
} else {
$str .= 'o' . substr($type[0], 0, 1);
}
}
return $str;
}
qq(and I'm spent);
package main;
use Data::AsString;
my $data = {
foo => {
one => [qw(x y z)]
},
bar => {
two => [qw(a b c)]
}
};
my $sig = Data::AsString->new($data);
print "signature of \$data is $sig\n";
HTH
broquaint | [reply]
[d/l] |
Re: Checking whether two variables have the same structure
by derby (Abbot) on Apr 09, 2002 at 18:23 UTC
|
#!/usr/bin/perl
use Inline C;
use strict;
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";
__END__
__C__
SV* describe( SV *var )
{
SV *tmp;
if( ! SvROK( var ) ) {
return( newSVpvf( "%s", "S" ) );
} else {
switch( SvTYPE( SvRV(var) ) ) {
case SVt_PVAV:
tmp = describe( av_pop( (AV *)SvRV(var) ) );
return( newSVpvf( "Ao%s", SvPV( tmp, PL_na ) ) );
case SVt_PVHV:
tmp = describe( hv_iterval( (HV *)SvRV(var),
hv_iternext( (HV *)SvRV(var) ) ) );
return( newSVpvf( "Ho%s", SvPV( tmp, PL_na ) ) );
case SVt_PVCV:
return( newSVpvf( "%s", "C" ) );
case SVt_PVGV:
return( newSVpvf( "%s", "G" ) );
case SVt_PVMG:
return( newSVpvf( "%s", "B" ) );
case SVt_RV:
tmp = describe( SvRV(var) );
return( newSVpvf( "r%s", SvPV( tmp, PL_na ) ) );
case SVt_IV:
case SVt_NV:
case SVt_PV:
return( newSVpvf( "%s", "oS" ) );
default:
return( newSVpvf( "?" ) );
}
}
}
-derby | [reply]
[d/l] |
Re: Checking whether two variables have the same structure
by elusion (Curate) on Apr 09, 2002 at 19:20 UTC
|
Here is my solution. Although not as in depth, I think it's quite simpler. Expanding it wouldn't be too hard. Right now it only checks for arrays and hashes.
#!/usr/bin/perl
use strict;
my $ref1 = [ { key => [ [ "foo" ] ] } ];
my $ref2 = [ [ { key => [ "bar" ] } ] ];
my $ref3 = [ { key => [ [ "baz" ] ] } ];
sub type {
my $obj = shift;
my $type;
START:
if (ref($obj) eq "HASH") {
$type .= "oH";
$obj = [values(%$obj)]->[0];
goto START;
} elsif (ref($obj) eq "ARRAY") {
$type .= "oA";
$obj = $obj->[0];
goto START;
}
$type =~ s/^o//;
return $type;
}
sub compare {
my $obj1 = shift;
my $obj2 = shift;
my $type1 = type($obj1);
my $type2 = type($obj2);
return $type1 eq $type2 ? 1 : 0;
}
print type($ref1); # Returns AoHoAoA
print compare($ref1, $ref2); # Returns 0
print compare($ref1, $ref3); # Returns 1
elusion : http://matt.diephouse.com
| [reply]
[d/l] |
Re: Checking whether two variables have the same structure
by George_Sherston (Vicar) on Apr 09, 2002 at 19:18 UTC
|
Data Dumper is *everyone's* friend (though you'd want to make sure that the default output for your version is the same as for mine):
use Data::Dumper;
sub tell_structure {
(my $string = Dumper(shift)) =~ s/\$VAR1 = //;
my %regexes = (
qr/^\[\s*/ => 'array',
qr/^\{\s*'\w*' => / => 'hash',
qr/^'\w*',*\n/ => 'value',
);
my @result;
my $regex = join "|", keys %regexes;
OUTER: while ($string =~ /$regex/) {
for my $regex (keys %regexes) {
if ($string =~ s/$regex//s) {
last OUTER if $regexes{$regex} eq 'value';
push @result, $regexes{$regex};
last;
}
}
}
return @result;
}
Then you can compare the contents of two returned arrays to determine whether the structures referenced are the same. Or you cd use this to tell you what you've got:
sub print_results {
if (@_ == 0) {
print "This data structure is a scalar";
}
else {
if ($_[0] eq 'array') {
print "This data structure is an array";
}
else {
print "This data structure is a hash";
}
shift;
for (@_) {
if ($_ eq 'hash') {
print ' of hashes';
}
elsif ($_ eq 'array') {
print ' of arrays';
}
}
}
print "!\n";
}
§ George Sherston | [reply]
[d/l]
[select] |
Re: Checking whether two variables have the same structure
by hossman (Prior) on Apr 10, 2002 at 07:30 UTC
|
- For some reason, using your code I get...
...
\$foo -> oS
...
which doesn't seem quite right.
-
I gotta side with George_Sherston on this one, It's
all about Data::Dumper. Here's what I can up with for
generating the grammer described (I think it can handle
any case the orriginal post did)...
sub my_describe {
my $s = Dumper(@_);
$s =~ s/\'[^\']*\'//g; # eliminate scalars
$s =~ s/[^\[\{\'\\]//g; # cut to the heart of the structure
# + because we only care about one member of hashes/arrays
$s =~ s/\[+/Ao/g;
$s =~ s/\{+/Ho/g;
$s =~ s/\\+/r/g;
return $s . "S";
}
UPDATE: I just realized this can't handle
something really basic: \\\\\\$foo.
Oh well, that's why version numbers were invented
| [reply]
[d/l] |
|
|
