Arbitrarily Complex Data Structure

[JR]

Hi. Is it possible to create a subroutine to handle an arbitrarily
complex data structure (for my purposes, complex only refers to hashes
and arrays)? In the below examples, I have a hash of hashes, and an
array of arrays, and then a fairly weak subroutine to handle the
individual processing of each. However, I don't know how to handle an
arbitrarily complex data structure, such as a hash of array of hash of
arrays. Is there any means by which to handle such a data structure
in a common subroutine, such as the below one, that can individually
handle a given hash of hashes or array of arrays? I ask because I may
need to be able to process a given data structure, but will not know
the complexity of said structure, other than that it will only include
combinations of arrays and hashes (the data structures will be placed
in various flat ascii files and sent to me).

#!/perl
use strict;
use warnings;
use diagnostics;

my %hoh = (
h1 => {
h1 => "v1",
h2 => "v2",
},
h2 => {
h3 => "v3",
h4 => "v4",
},
h3 => {
h5 => "v5",
h6 => "v6",
},
);

my @aoa = (
[ 0, 1, 2 ],
[ 3, 4, 5 ],
[ 6, 7, 8 ],
);

my %hoa = (
flinstones => [ "fred", "barney" ],
jetsones => [ "george", "jane", "elroy" ],
simpsons => [ "homer", "marge", "bart" ],
);

sub T {
## The '|| "@_" =~ /HASH/' statement is needed because
## perl does not recognize the apparent address of
## HASH(0x1ab2eb4) with the ref function---this
## code can easily break.
if (ref(@_) eq 'HASH' || "@_" =~ /HASH/) {
my $x = shift;
while (my($k, $v) = each %$x) {
if (ref($v) eq 'HASH') {
print "\n$k\n";
T($v);
}
else {
print "$k=$v\n";
}
}
}
else {
for (0..$#_) {
my $e = $_[$_];
if (ref($e) eq 'ARRAY') {
T(@$e);
}
else {
print "$e\n";
}
}
}
}

T(\@aoa); # succeeds
T(\%hoh); # succeeds
T(\%hoa); # fails
=pod
# OUTPUT of failure
simpsons=ARRAY(0x1ab2da0)
jetsones=ARRAY(0x1ab56f4)
flinstones=ARRAY(0x1ab558c)
=cut

## One standard means of printing %hoa--how can I possibly
## code something such as this for an arbitrarily complex
## data structure?
print "$_ @{ $hoa{$_} }\n" for (sort keys %hoa);

Thanks in advance to anyone who offers any advice on how to solve the
above problem.

JR

[JR]

Brian McCauley <nobull@mail.com> wrote in message news:<u97k4xen8c.fsf@wcl-l.bham.ac.uk>...

> [email]jrolandumuc@yahoo.com[/email] (JR) writes:
>

> > Hi. Is it possible to create a subroutine to handle an arbitrarily
> > complex data structure (for my purposes, complex only refers to hashes
> > and arrays)?

>
> Yes, the ref operator and recursion.
>
> But looking at your code you knew that. You just executed it
> exteemly carelessly.
>

> > ## The '|| "@_" =~ /HASH/' statement is needed because
> > ## perl does not recognize the apparent address of
> > ## HASH(0x1ab2eb4) with the ref function---this
> > ## code can easily break.
> > if (ref(@_) eq 'HASH' || "@_" =~ /HASH/) {

>
> ref(@_) will always be ''. The _number_ of elements in an array will
> never be a reference (it will always be an integer).
>
> I suggest that you try looking at your code and following the logic.
>

> > sub T {
> > if ( "@_" =~ /HASH/) {
> > my $x = shift;
> > while (my($k, $v) = each %$x) {
> > if (ref($v) eq 'HASH') {
> > print "\n$k\n";
> > T($v);
> > }
> > else {
> > print "$k=$v\n";
> > }
> > }
> > }
> > else {
> > for (0..$#_) {
> > my $e = $_[$_];
> > if (ref($e) eq 'ARRAY') {
> > T(@$e);
> > }
> > else {
> > print "$e\n";
> > }
> > }
> > }
> > }

>
> So if _any_ of the arguments passed to T are hashrefs (or strings
> containing 'HASH' you try to interpret the first argument as a hashref
> and ignore the rest?
>
> Surely that's not what you intended!
>
> You probably meant something like.
>
> sub T {
> for ( @_ ) {
> if ( ref eq 'HASH' ) {
> # Do stuff with %$_
> } elsif ( ref eq 'ARRAY' ) {
> T(@$_);
> } else {
> # Do stuff with $_
> }
> }
> }

Actually, I said that the subroutine was "weak," so the comments about
careless execution are irrelevant. I know the subroutine isn't usable
(nor is it intended to be--this is just to show that I have made some
attempt to solve the problem, before bothering anyone in this
newsgroup), but thanks for reiterating that.

I realize that my question may not have been perfecting clear. I know
how to use recursion to iteratate through an arbitrarily complex array
of arrays OR hash of hashes, but I don't have a clue as to how to
iteratate through a more arbitrarily complex data structure that *may*
include a hash of hash of arrays, vice versa, or an array of array of
hashes, etcetera. Is there a way to handle such an arbitrarily
complex data structure? How, for example, can recursion be used to
dynamically traverse the hash of arrays I submitted in my example, if
I didn't know beforehand that the below %hoa contained a hash and
three anonymous arrays? I just don't see how this would work. If
another %hoa were added to a fourth hash key, for example, how could I
handle that without modifying my code? Is that even possible? A
given recursive subroutine could handle an array of arrays OR a hash
of hashes, but could one also be created to handle many levels of a
combination of these elements?

my %hoa = (
flinstones => [ "fred", "barney" ],
jetsones => [ "george", "jane", "elroy" ],
simpsons => [ "homer", "marge", "bart" ],
## Someone adds a fourth key here containing a hash of hash
## of array of hash of arrays...the recursive subroutine to process
## this existing data structure would have to change, or is
## it possible to code it in such a way that it wouldn't?
);

## Works for above data structure, before fourth key is added.
## This is not intended to be a usable sub, though, just an
## example of my attempt to solve the above-described problem.
sub recurseArbDataStructure {
my $arg = shift;
if (ref($arg) eq 'HASH') {
while (my ($k, $v) = each %$arg) {
print "Key: $k\n" if ref($v) ne 'HASH';
if (ref($v) eq 'HASH') {
recurseArbDataStructure($v);
}
elsif (ref($v) eq 'ARRAY') {
for my $y (@$v) {
if (ref($y) ne 'ARRAY') {
print "\t$y\n";
}
else {
recurseArbDataStructure(@$y);
}
}
}
}
}
}

recurseArbDataStructure(\%hoa);

Thanks.

JR

[JR]

[email]jrolandumuc@yahoo.com[/email] (JR) wrote in message news:<b386d54b.0308291231.4ca368cd@posting.google. com>...

> Brian McCauley <nobull@mail.com> wrote in message news:<u97k4xen8c.fsf@wcl-l.bham.ac.uk>...

> > [email]jrolandumuc@yahoo.com[/email] (JR) writes:
> >

> > > Hi. Is it possible to create a subroutine to handle an arbitrarily
> > > complex data structure (for my purposes, complex only refers to hashes
> > > and arrays)?

> >
> > Yes, the ref operator and recursion.
> >
> > But looking at your code you knew that. You just executed it
> > exteemly carelessly.
> >

> > > ## The '|| "@_" =~ /HASH/' statement is needed because
> > > ## perl does not recognize the apparent address of
> > > ## HASH(0x1ab2eb4) with the ref function---this
> > > ## code can easily break.
> > > if (ref(@_) eq 'HASH' || "@_" =~ /HASH/) {

> >
> > ref(@_) will always be ''. The _number_ of elements in an array will
> > never be a reference (it will always be an integer).
> >
> > I suggest that you try looking at your code and following the logic.
> >

> > > sub T {
> > > if ( "@_" =~ /HASH/) {
> > > my $x = shift;
> > > while (my($k, $v) = each %$x) {
> > > if (ref($v) eq 'HASH') {
> > > print "\n$k\n";
> > > T($v);
> > > }
> > > else {
> > > print "$k=$v\n";
> > > }
> > > }
> > > }
> > > else {
> > > for (0..$#_) {
> > > my $e = $_[$_];
> > > if (ref($e) eq 'ARRAY') {
> > > T(@$e);
> > > }
> > > else {
> > > print "$e\n";
> > > }
> > > }
> > > }
> > > }

> >
> > So if _any_ of the arguments passed to T are hashrefs (or strings
> > containing 'HASH' you try to interpret the first argument as a hashref
> > and ignore the rest?
> >
> > Surely that's not what you intended!
> >
> > You probably meant something like.
> >
> > sub T {
> > for ( @_ ) {
> > if ( ref eq 'HASH' ) {
> > # Do stuff with %$_
> > } elsif ( ref eq 'ARRAY' ) {
> > T(@$_);
> > } else {
> > # Do stuff with $_
> > }
> > }
> > }

>
> Ahhh, I think I understand now how to do what I'm attempting. I
> couldn't get my head around it before, but after my last post, I think
> I now understand how to do it. It won't be easy, but it is definitely
> doable.
>
> Thanks for the response, Brian.

### I came up with and tested the below code on a few dozens complex data
### structures. As long as the subroutine was passed a reference, and
### the data structures contained either a scalar, code, hash, array,
### or ref, or references to these, the subroutine returned the contents
### of the data structure. This could be factored and improved upon, but
### is a decent second attempt, and seems to do the job I need it to do well.
### The Data::Dumper module does the same thing, but returns more
### information than I really need---I only need the contents
### (there's probably a way to turn off this extra info., I'm guessing).

#!/perl -w
use strict;
use diagnostics;

### Traverse data structures of varying complexity

my $c = 0;
sub traverse {
my $arg = shift;

## Initial argument must be a reference.
## If argument is passed a reference data structure,
## but not as a reference, this block will be circumvented,
## and the passed reference may not be completely traversed.
if (!$c && ref($arg) ne 'REF' &&
ref($arg) ne 'HASH' &&
ref($arg) ne 'ARRAY' &&
ref($arg) ne 'CODE' &&
ref($arg) ne 'SCALAR') {
die "Data structure must be passed as a reference.\n";
}

## Handle references to a reference
if (ref($arg) eq 'REF') {
## Try hash
eval { %$arg; };
traverse(%$arg) if (!$@);

## Try array
eval { @$arg; };
traverse(@$arg) if (!$@);

## Try scalar
eval { $$arg; };
traverse($$arg) if (!$@);

## Try code
eval { &$arg; };
traverse(&$arg) if (!$@);
}
elsif (ref($arg) eq 'HASH') {
for (%$arg) {
if (ref($_) eq 'HASH' ||
ref($_) eq 'ARRAY' ||
ref($_) eq 'SCALAR' ||
ref($_) eq 'CODE' ||
ref($_) eq 'REF' ) {
traverse($_);
}
else {
print $_, "\n";
}
}
}
elsif (ref($arg) eq 'ARRAY') {
for (@$arg) {
if (ref($_) eq 'HASH' ||
ref($_) eq 'ARRAY' ||
ref($_) eq 'SCALAR' ||
ref($_) eq 'CODE' ||
ref($_) eq 'REF' ) {
traverse($_);
}
else {
print $_, "\n";
}
}
}
elsif (ref($arg) eq 'SCALAR') {
if (ref($$arg) eq 'HASH' ||
ref($$arg) eq 'ARRAY' ||
ref($$arg) eq 'SCALAR' ||
ref($$arg) eq 'CODE' ||
ref($$arg) eq 'REF' ) {
traverse($$arg);
}
else {
print $$arg, "\n";
}
}
elsif (ref($arg) eq 'CODE') {
if (ref(&$arg()) eq 'HASH' ||
ref(&$arg()) eq 'ARRAY' ||
ref(&$arg()) eq 'SCALAR'||
ref(&$arg()) eq 'CODE' ||
ref(&$arg()) eq 'REF') {
traverse(&$arg);
}
else {
&$arg();
}
}
else {
warn "EXCEPTION: $arg\n";
}
$c++ if $c < 2;
}

my @nums = (10..20);
my %langs = (e=>"English", s=>"Spanish", r=>"Russian");
my $greeting = "Hello, World!";
sub greeting { my $arg = shift; return "Hello, $arg!"; }
my @matrix = (
[ 0, 1, 2 ],
[ 3, 4, 5 ],
[ 6, 7, 8 ],
);

my %hoh = (
hash1 => {
h1k1 => h1v1,
h1k2 => h1v2,
},
hash2 => {
h2k1 => h2v1,
h2k2 => h2v2,
},
hash3 => {
h3k1 => h3v1,
h3k2 => h3v2,
s3k3 => [@matrix],
},
);

my @aoh = (
{
key1 => val1,
key2 => val2,
},
{
key3 => val3,
key4 => val4,
},
{
key5 => val5,
key6 => val6,
},
);

my %hoa = (
hoa_key1 => [ "hoa_anon1", [ "hoa_int_anon1" ], "hoa_anon1a" ],
hoa_key2 => [ "hoa_anon2", [ "hoa_int_anon2" ], "hoa_anon2a" ],
hoa_key3 => [ "hoa_anon3", [ "hoa_int_anon3" ], "hoa_anon3a" ],
);

my %ds = (
scalar1 => \\\\\\\\\\\\\\\\$greeting,
sub1 => \\\\\\\\\\\\\\\\greeting("John"),
anon1 => [@nums],
hash1 => [%langs],
combo => [\\\\$greeting,[\\\\@nums,[\\\\%langs,[\\\\&greeting
("John")],],],],
aoa => [@matrix],
hoh => \\\\%hoh,
aoh => \\\\[@aoh],
hoa => \\\\[%hoa],
norefscalar => $greeting,
layeredstuct => [[%hoa, \\\[@aoh, \\\\[[%hoh],], [@matrix],],],],
);

traverse(\%ds);

[Brian McCauley]

[email]jrolandumuc@yahoo.com[/email] (JR) writes:

> ### I came up with and tested the below code on a few dozens complex data
> ### structures. As long as the subroutine was passed a reference, and
> ### the data structures contained either a scalar, code, hash, array,
> ### or ref, or references to these, the subroutine returned the contents
> ### of the data structure. This could be factored and improved upon, but
> ### is a decent second attempt, and seems to do the job I need it to do well.
> ### The Data::Dumper module does the same thing, but returns more
> ### information than I really need---I only need the contents
> ### (there's probably a way to turn off this extra info., I'm guessing).
>
> #!/perl -w
> use strict;
> use diagnostics;
>
> ### Traverse data structures of varying complexity
>
> my $c = 0;
> sub traverse {
> my $arg = shift;
>
> ## Initial argument must be a reference.
> ## If argument is passed a reference data structure,
> ## but not as a reference, this block will be circumvented,
> ## and the passed reference may not be completely traversed.
> if (!$c && ref($arg) ne 'REF' &&
> ref($arg) ne 'HASH' &&
> ref($arg) ne 'ARRAY' &&
> ref($arg) ne 'CODE' &&
> ref($arg) ne 'SCALAR') {
> die "Data structure must be passed as a reference.\n";
> }

Hmmm... why not just !ref($arg) you need to re-check for un-handled
reference types again later so there's no need to enumerate all
handled types here.

Actually I think the whole check is probably better removed - I can't
see it does anything usefull. If you want to ensure that traverse()
is only passed a single argument then a prototype would be simpler.

> ## Handle references to a reference
>
> if (ref($arg) eq 'REF') {
> ## Try hash
> eval { %$arg; };
> traverse(%$arg) if (!$@);

That can never do anyting. We know ref($arg) is 'REF' so $@ will
always be 'Not a HASH reference'

You meant

eval { %$$arg; };
traverse(\%$$arg) if (!$@);

Or more simply

traverse($$arg);

Which, like I said is just like treating 'REF' like scalar.

> elsif (ref($arg) eq 'SCALAR') {
> if (ref($$arg) eq 'HASH' ||
> ref($$arg) eq 'ARRAY' ||
> ref($$arg) eq 'SCALAR' ||
> ref($$arg) eq 'CODE' ||
> ref($$arg) eq 'REF' ) {
> traverse($$arg);
> }

This can never do anthing since there's no way the conditions in both
ifs can be met. (If ref($$arg) is HASH then ref($arg) must be 'REF').

Just make it

elsif (ref($arg) eq 'REF') {
traverse($$arg);
}

> elsif (ref($arg) eq 'CODE') {
> if (ref(&$arg()) eq 'HASH' ||
> ref(&$arg()) eq 'ARRAY' ||
> ref(&$arg()) eq 'SCALAR'||
> ref(&$arg()) eq 'CODE' ||
> ref(&$arg()) eq 'REF') {
> traverse(&$arg);
> }

Eeek! Why are you calling the subroutine 6 times? Why not call it
once and store the value? Why are you calling it with an empry
argument list the first 5 times and with @_ pass-though the last time?

&$arg() is more conventionally written as $arg->()

I think you meant:
elsif (ref($arg) eq 'CODE') {
traverse(&$arg->());
}

All-in-all, removing redundant or unreachable code, your traverse
function() simplifies to:

sub traverse($) {
my $arg = shift;
if ( !ref $arg ) {
print "$arg\n";
} elsif (ref($arg) eq 'HASH') {
for (%$arg) {
traverse($_);
}
}
elsif (ref($arg) eq 'ARRAY') {
for (@$arg) {
traverse($_);
}
}
elsif (ref($arg) eq 'SCALAR' || ref($arg) eq 'REF') {
traverse($$arg);
}
elsif (ref($arg) eq 'CODE') {
traverse($arg->());
}
else {
warn "EXCEPTION: $arg\n";
}
}

--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\

[Vlad Tepes]

JR <jrolandumuc@yahoo.com> wrote:

>jrolandumuc@yahoo.com (JR) wrote in message news:<b386d54b.0308291231.4ca368cd@posting.google. com>...

>>Brian McCauley <nobull@mail.com> wrote in message news:<u97k4xen8c.fsf@wcl-l.bham.ac.uk>...

>>> [email]jrolandumuc@yahoo.com[/email] (JR) writes:
>>>
>>>> Hi. Is it possible to create a subroutine to handle an arbitrarily
>>>> complex data structure (for my purposes, complex only refers to hashes
>>>> and arrays)?

I just palyed some small with tarversing. Maybe yo like to have a loko:

sub processitem($) {
my $indent = shift;
my $item = shift || $_;
print "$indent ", " " x $indent, $item, "\n";
}

sub trav(@); # must declare sub to prototype recurs. func.

sub trav {
my $i = ref $_[0] ? 0 : 1 + shift; # indentation
foreach ( @_ ) {
/HASH/ && do{ trav $i, %$_; next };
/ARRAY/ && do{ trav $i, @$_; next };
/CODE/ && do{ trav $i, $_->(); next };
/REF/ && do{ trav $i, $$_ ; next };
processitem $i;
}
}

trav \%hoh, \\\\\%hah, \%hah, \%heh;

Cherio,
--
Vlad

[JR]

Vlad Tepes <minceme@start.no> wrote in message news:<bj7tln$pdr$1@troll.powertech.no>...

> JR <jrolandumuc@yahoo.com> wrote:
>

> >jrolandumuc@yahoo.com (JR) wrote in message news:<b386d54b.0308291231.4ca368cd@posting.google. com>...

> >>Brian McCauley <nobull@mail.com> wrote in message news:<u97k4xen8c.fsf@wcl-l.bham.ac.uk>...
> >>> [email]jrolandumuc@yahoo.com[/email] (JR) writes:
> >>>
> >>>> Hi. Is it possible to create a subroutine to handle an arbitrarily
> >>>> complex data structure (for my purposes, complex only refers to hashes
> >>>> and arrays)?

>
> I just palyed some small with tarversing. Maybe yo like to have a loko:
>
> sub processitem($) {
> my $indent = shift;
> my $item = shift || $_;
> print "$indent ", " " x $indent, $item, "\n";
> }
>
> sub trav(@); # must declare sub to prototype recurs. func.
>
> sub trav {
> my $i = ref $_[0] ? 0 : 1 + shift; # indentation
> foreach ( @_ ) {
> /HASH/ && do{ trav $i, %$_; next };
> /ARRAY/ && do{ trav $i, @$_; next };
> /CODE/ && do{ trav $i, $_->(); next };
> /REF/ && do{ trav $i, $$_ ; next };
> processitem $i;
> }
> }
>
> trav \%hoh, \\\\\%hah, \%hah, \%heh;
>
> Cherio,

Interesting approach! Your code is maximally succinct. When I passed
it a reference to my ridiculously complex %ds hash, it produced the
below output (I also passed it far less ridiculous hashes and arrays,
and it processed those perfectly). When I added in a line to handle
scalars, it perfectly processed a reference to %ds. I didn't bother
trying to indent, the way you did (I just needed to get the actual raw
data out of the data structure). That was a nice touch.

Prototype mismatch: sub main::trav (@_) vs none at test.pl line 79.
1 hoa
1 SCALAR(0x1aa7848)
1 aoh
1 SCALAR(0x1aa7794)
1 hash1
2 e
2 English
2 r
2 Russian
2 s
2 Spanish
1 norefscalar
1 Hello, World!
1 combo
2 SCALAR(0x1aa8274)
3 SCALAR(0x1aa82a4)
4 SCALAR(0x1aa82d4)
5 SCALAR(0x1aa8310)
1 anon1
2 10
2 11
2 12
2 13
2 14
2 15
2 16
2 17
2 18
2 19
2 20
1 hoh
1 SCALAR(0x1aa8430)
1 scalar1
1 SCALAR(0x1aac2cc)
1 sub1
1 SCALAR(0x1aa8124)
1 aoa
3 0
3 1
3 2
3 3
3 4
3 5
3 6
3 7
3 8
1 layeredstuct
3 hoa_key1
4 hoa_anon1
5 hoa_int_anon1
4 hoa_anon1a
3 hoa_key2
4 hoa_anon2
5 hoa_int_anon2
4 hoa_anon2a
3 hoa_key3
4 hoa_anon3
5 hoa_int_anon3
4 hoa_anon3a
3 SCALAR(0x1aa79f8)

The below code is as succinct I could get it (within reason), for what
I was trying to accomplish. I was a little dissapointed about not
being able to factor this code down a little more, but at least it did
spit out exactly the output that I wanted, for every data structure I
passed it (which is why I bothered putting it into a class). I'll be
able to make it more succinct now, thanks to your code.

Thanks.

JR

---- calling script ----
use lib 'OO_Practice';
use strict;
use TRAVERSE;

## Pass it a reference to the %ds hash from previous message
my $object = TRAVERSE->new(\%ds)->printTree;

---- receiving class ----
package TRAVERSE;
use strict;

### This class recursively traverses any arbitrarily deep data
structure that
### has any number of references to hashes, arrays, scalars or
subroutines;
### other types are tagged as exceptions. The data structure must be
passed
### as a reference.

my $iteration_count = 0;
my $obj;

sub new {
my $class = shift;
$class = ref($class) || $class;
my $self = [@_];
bless $self, $class;
$self->_extract_reference();
return $self;
}

sub _extract_reference {
my $self = shift;
$self->_traverse(@$self);
}

sub _traverse {
my $arg;
if (!$iteration_count) {
my $self = shift;
$iteration_count++;
$arg = shift;
_traverse($arg);
}
else {
$arg = shift;
}

## Initial argument must be a reference.
## If argument is passed a reference data structure,
## but not as a reference, this block will be circumvented,
## and the passed reference may not be completely _traversed.
if ($iteration_count == 1 && ref($arg) ne 'REF' &&
ref($arg) ne 'HASH' &&
ref($arg) ne 'ARRAY' &&
ref($arg) ne 'CODE' &&
ref($arg) ne 'SCALAR') {
die "Data structure must be passed as a reference.\n";
}

## Handle references to a reference
if (ref($arg) eq 'REF') {
## Try hash
eval { %$arg; };
_traverse(%$arg) if (!$@);

## Try array
eval { @$arg; };
_traverse(@$arg) if (!$@);

## Try scalar
eval { $$arg; };
_traverse($$arg) if (!$@);

## Try code
eval { &$arg; };
_traverse(&$arg) if (!$@);
}
elsif (ref($arg) eq 'HASH') {
for (%$arg) {
ref($_) eq 'HASH' || ref($_) eq 'ARRAY' || ref($_) eq
'SCALAR' ||
ref($_) eq 'CODE' ||
ref($_) eq 'REF' ? _traverse($_) : push @{$obj->{tree}}, $_,
"\n";
}
}
elsif (ref($arg) eq 'ARRAY') {
for (@$arg) {
ref($_) eq 'HASH' || ref($_) eq 'ARRAY' || ref($_) eq
'SCALAR' ||
ref($_) eq 'CODE' ||
ref($_) eq 'REF' ? _traverse($_) : push @{$obj->{tree}}, $_,
"\n";
}
}
elsif (ref($arg) eq 'SCALAR') {
ref($$arg) eq 'HASH' || ref($$arg) eq 'ARRAY' || ref($$arg) eq
'SCALAR' ||
ref($$arg) eq 'CODE' || ref($$arg) eq 'REF' ? _traverse($$arg) :
push @{$obj->{tree}}, $$arg, "\n";
}
elsif (ref($arg) eq 'CODE') {
ref(&$arg()) eq 'HASH' || ref(&$arg()) eq 'ARRAY' ||
ref(&$arg()) eq 'SCALAR'||
ref(&$arg()) eq 'CODE' ||
ref(&$arg()) eq 'REF' ? _traverse(&$arg) : push @{$obj->{tree}},
&$arg();
}
else {
push @{$obj->{tree}}, warn "EXCEPTION: $arg\n";
}
}

sub printTree {
my $self = shift;
print "$_" for @{$obj->{tree}};
}

1;

[JR]

Vlad Tepes <minceme@start.no> wrote in message news:<bj7tln$pdr$1@troll.powertech.no>...

> JR <jrolandumuc@yahoo.com> wrote:
>

> >jrolandumuc@yahoo.com (JR) wrote in message news:<b386d54b.0308291231.4ca368cd@posting.google. com>...

> >>Brian McCauley <nobull@mail.com> wrote in message news:<u97k4xen8c.fsf@wcl-l.bham.ac.uk>...
> >>> [email]jrolandumuc@yahoo.com[/email] (JR) writes:
> >>>
> >>>> Hi. Is it possible to create a subroutine to handle an arbitrarily
> >>>> complex data structure (for my purposes, complex only refers to hashes
> >>>> and arrays)?

>
> I just palyed some small with tarversing. Maybe yo like to have a loko:
>
> sub processitem($) {
> my $indent = shift;
> my $item = shift || $_;
> print "$indent ", " " x $indent, $item, "\n";
> }
>
> sub trav(@); # must declare sub to prototype recurs. func.
>
> sub trav {
> my $i = ref $_[0] ? 0 : 1 + shift; # indentation
> foreach ( @_ ) {
> /HASH/ && do{ trav $i, %$_; next };
> /ARRAY/ && do{ trav $i, @$_; next };
> /CODE/ && do{ trav $i, $_->(); next };
> /REF/ && do{ trav $i, $$_ ; next };
> processitem $i;
> }
> }
>
> trav \%hoh, \\\\\%hah, \%hah, \%heh;
>
> Cherio,

With your technique, I was able to significantly factor-down my code
(the one key component I was forgetting is that a reference to a
reference is always dereferenced as a scalar---that's why I had so
many unnecessary evals in my first script). I also noticed that the
ref has to be tested for in the for loop--using regex can lead to some
mistakes. Anyway, below is the much more succinct code for my class
and calling script. Thanks, Vlad.

---calling script---
use lib 'OO_Practice';
use strict;
use warnings;
use diagnostics;
use TRAVERSE;

my $object = TRAVERSE->new(\%ds);

---receiving class (not really OO, just uses an OO interface)---

package TRAVERSE;
use strict;

my $obj;

sub new {
my $class = shift;
$class = ref($class) || $class;
my $data = \@_;
_trav(@$data);
print "$_" for @{$obj->{tree}};
my $self = [@{$obj->{tree}}];
bless $self, $class;
return $self;
}

sub _trav {
my $arg = ref $_[0];

for (@_) {
if (!ref($_)) {print "$_\n"; next;}
S: {
if (ref($_) eq 'REF') {_trav($$_); last S;}
if (ref($_) eq 'HASH') {_trav(%$_); last S;}
if (ref($_) eq 'ARRAY') {_trav(@$_); last S;}
if (ref($_) eq 'SCALAR') {_trav($$_); last S;}
if (ref($_) eq 'CODE') {_trav(&$arg()); last S;}
push @{$obj->{tree}}, warn "EXCEPTION: $_\n";
};
}
}

1;

That's it!

[Bryan Castillo]

Vlad Tepes <minceme@start.no> wrote in message news:<bj7tln$pdr$1@troll.powertech.no>...

> JR <jrolandumuc@yahoo.com> wrote:
>

> >jrolandumuc@yahoo.com (JR) wrote in message news:<b386d54b.0308291231.4ca368cd@posting.google. com>...

> >>Brian McCauley <nobull@mail.com> wrote in message news:<u97k4xen8c.fsf@wcl-l.bham.ac.uk>...
> >>> [email]jrolandumuc@yahoo.com[/email] (JR) writes:
> >>>
> >>>> Hi. Is it possible to create a subroutine to handle an arbitrarily
> >>>> complex data structure (for my purposes, complex only refers to hashes
> >>>> and arrays)?

>
> I just palyed some small with tarversing. Maybe yo like to have a loko:
>
> sub processitem($) {
> my $indent = shift;
> my $item = shift || $_;
> print "$indent ", " " x $indent, $item, "\n";
> }
>
> sub trav(@); # must declare sub to prototype recurs. func.
>
> sub trav {
> my $i = ref $_[0] ? 0 : 1 + shift; # indentation
> foreach ( @_ ) {
> /HASH/ && do{ trav $i, %$_; next };
> /ARRAY/ && do{ trav $i, @$_; next };
> /CODE/ && do{ trav $i, $_->(); next };
> /REF/ && do{ trav $i, $$_ ; next };
> processitem $i;
> }
> }
>
> trav \%hoh, \\\\\%hah, \%hah, \%heh;
>

# DON'T TRY DOING THIS THOUGH!
# fyi Data::Dumper handles it

my $a = { name => 'bryan', age => 26 };
$a->{evil_death} = $a;
trav($a);

> Cherio,

[Vlad Tepes]

JR <jrolandumuc@yahoo.com> wrote:

> With your technique, I was able to significantly factor-down my code
> (the one key component I was forgetting is that a reference to a
> reference is always dereferenced as a scalar---that's why I had so
> many unnecessary evals in my first script). I also noticed that the
> ref has to be tested for in the for loop--using regex can lead to some
> mistakes. Anyway, below is the much more succinct code for my class
> and calling script. Thanks, Vlad.

Great JR! I haven't tested it, but this looks far better than the code
you first posted. But, as Bryan pointed out, it doesn't handle circular
references.

And regexes can be nice, you could use them to recursively print
objects:

$t = bless {}, "Some::Package";
print $t; # Some::Package=HASH(0x838cd50)
if (ref $t) {
last unless $t =~ /=(\w+)/;
print "\$t is a reference to a $1\n";
}

Unfortunately, the snippet I posted didn't check for a reference before
performing the pattern matches, so it would wrongly assume that a string
matching /HASH|REF|ARRAY|CODE/ would be a reference... But that's how it
is with fresh code, it takes time to discover and fix the bugs.

That's one important reason to use modules. Unless you're coding to
learn something, search.cpan.org before you start.

Regards,
--
Vlad

[Vlad Tepes]

Bryan Castillo <rook_5150@yahoo.com> wrote:

> Vlad Tepes <minceme@start.no> wrote

>> JR <jrolandumuc@yahoo.com> wrote:

>> >jrolandumuc@yahoo.com (JR) wrote
>> >>Brian McCauley <nobull@mail.com> wrote
>> >>> [email]jrolandumuc@yahoo.com[/email] (JR) writes:
>> >>>
>> >>>> Hi. Is it possible to create a subroutine to handle an arbitrarily
>> >>>> complex data structure (for my purposes, complex only refers to hashes
>> >>>> and arrays)?

>>
>> I just palyed some small with tarversing. Maybe yo like to have a loko:
>>
>> sub processitem($) {
>> my $indent = shift;
>> my $item = shift || $_;
>> print "$indent ", " " x $indent, $item, "\n";
>> }
>>
>> sub trav(@); # must declare sub to prototype recurs. func.
>>
>> sub trav {
>> my $i = ref $_[0] ? 0 : 1 + shift; # indentation
>> foreach ( @_ ) {
>> /HASH/ && do{ trav $i, %$_; next };
>> /ARRAY/ && do{ trav $i, @$_; next };
>> /CODE/ && do{ trav $i, $_->(); next };
>> /REF/ && do{ trav $i, $$_ ; next };
>> processitem $i;
>> }
>> }
>>
>> trav \%hoh, \\\\\%hah, \%hah, \%heh;
>>

> # DON'T TRY DOING THIS THOUGH!
> # fyi Data::Dumper handles it
>
> my $a = { name => 'bryan', age => 26 };
> $a->{evil_death} = $a;
> trav($a);

Yes, this snippet loops infinitely on circular references. (There are
also other errors in it.)

But I can't see how you could use Data::Dumper to print only the values
of datastructures.

Regards,
--
Vlad

[JR]

Vlad Tepes <minceme@start.no> wrote in message news:<bja07u$ev6$1@troll.powertech.no>...

> Bryan Castillo <rook_5150@yahoo.com> wrote:

> > Vlad Tepes <minceme@start.no> wrote

> >> JR <jrolandumuc@yahoo.com> wrote:
> >> >jrolandumuc@yahoo.com (JR) wrote
> >> >>Brian McCauley <nobull@mail.com> wrote
> >> >>> [email]jrolandumuc@yahoo.com[/email] (JR) writes:
> >> >>>
> >> >>>> Hi. Is it possible to create a subroutine to handle an arbitrarily
> >> >>>> complex data structure (for my purposes, complex only refers to hashes
> >> >>>> and arrays)?
> >>
> >> I just palyed some small with tarversing. Maybe yo like to have a loko:
> >>
> >> sub processitem($) {
> >> my $indent = shift;
> >> my $item = shift || $_;
> >> print "$indent ", " " x $indent, $item, "\n";
> >> }
> >>
> >> sub trav(@); # must declare sub to prototype recurs. func.
> >>
> >> sub trav {
> >> my $i = ref $_[0] ? 0 : 1 + shift; # indentation
> >> foreach ( @_ ) {
> >> /HASH/ && do{ trav $i, %$_; next };
> >> /ARRAY/ && do{ trav $i, @$_; next };
> >> /CODE/ && do{ trav $i, $_->(); next };
> >> /REF/ && do{ trav $i, $$_ ; next };
> >> processitem $i;
> >> }
> >> }
> >>
> >> trav \%hoh, \\\\\%hah, \%hah, \%heh;
> >>

> > # DON'T TRY DOING THIS THOUGH!
> > # fyi Data::Dumper handles it
> >
> > my $a = { name => 'bryan', age => 26 };
> > $a->{evil_death} = $a;
> > trav($a);

>
> Yes, this snippet loops infinitely on circular references. (There are
> also other errors in it.)
>
> But I can't see how you could use Data::Dumper to print only the values
> of datastructures.
>
> Regards,

Thanks to everyone for their suggestions, especially Vlad. The below
constructor is my final product, for now. I'll leave handling
circular references, and other reference types, for another day. I
know that the
data structures that will be passed to the script will not contain
circular
references or references to anything other than arrays, hashes, subs,
or
scalars, so the below is fine, for now. This was an enlightening
project
on which to work.

--------------
use strict;
package TRAVERSE;

sub new {
my ($self, $class, @pobj);
if (caller =~ /main|\.pl/) { # first call
$class = shift;
$class = ref($class) || $class;
}
for (@_) { # all recursive calls
if(!ref($_)) {push @pobj, $_; next;}
ref($_) eq 'REF' ? new($$_) : ref($_) eq 'HASH' ?
new(%$_) :
ref($_) eq 'ARRAY' ? new(@$_) : ref($_) eq 'SCALAR' ?
new($$_) :
ref($_) eq 'CODE' ? new($_->()) :
print "<<<EXCEPTION: $_>>>\n";
}
if (!/^\s*$/) { # recursion is complete
$self = [@pobj]; # create reference to data
bless $self, $class; # create object
}
print "$_\n" for @$self; # print object
return $self; # return object
}

1;