Arbitrarily Complex Data Structure

Discussion in 'Perl Misc' started by JR, Aug 28, 2003.

  1. JR

    JR Guest

    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, Aug 28, 2003
    #1
    1. Advertising

  2. JR

    JR Guest

    Brian McCauley <> wrote in message news:<>...
    > (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, Aug 29, 2003
    #2
    1. Advertising

  3. JR

    JR Guest

    (JR) wrote in message news:<>...
    > Brian McCauley <> wrote in message news:<>...
    > > (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);
     
    JR, Sep 2, 2003
    #3
  4. (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\\
     
    Brian McCauley, Sep 4, 2003
    #4
  5. JR

    Vlad Tepes Guest

    JR <> wrote:

    > (JR) wrote in message news:<>...
    >>Brian McCauley <> wrote in message news:<>...
    >>> (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
     
    Vlad Tepes, Sep 4, 2003
    #5
  6. JR

    JR Guest

    Vlad Tepes <> wrote in message news:<bj7tln$pdr$>...
    > JR <> wrote:
    >
    > > (JR) wrote in message news:<>...
    > >>Brian McCauley <> wrote in message news:<>...
    > >>> (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, Sep 4, 2003
    #6
  7. JR

    JR Guest

    Vlad Tepes <> wrote in message news:<bj7tln$pdr$>...
    > JR <> wrote:
    >
    > > (JR) wrote in message news:<>...
    > >>Brian McCauley <> wrote in message news:<>...
    > >>> (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!
     
    JR, Sep 4, 2003
    #7
  8. Vlad Tepes <> wrote in message news:<bj7tln$pdr$>...
    > JR <> wrote:
    >
    > > (JR) wrote in message news:<>...
    > >>Brian McCauley <> wrote in message news:<>...
    > >>> (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,
     
    Bryan Castillo, Sep 5, 2003
    #8
  9. JR

    Vlad Tepes Guest

    JR <> 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, Sep 5, 2003
    #9
  10. JR

    Vlad Tepes Guest

    Bryan Castillo <> wrote:
    > Vlad Tepes <> wrote
    >> JR <> wrote:
    >> > (JR) wrote
    >> >>Brian McCauley <> wrote
    >> >>> (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
     
    Vlad Tepes, Sep 5, 2003
    #10
  11. JR

    JR Guest

    Vlad Tepes <> wrote in message news:<bja07u$ev6$>...
    > Bryan Castillo <> wrote:
    > > Vlad Tepes <> wrote
    > >> JR <> wrote:
    > >> > (JR) wrote
    > >> >>Brian McCauley <> wrote
    > >> >>> (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;
     
    JR, Sep 5, 2003
    #11
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Jeff

    complex data structure

    Jeff, Jun 26, 2004, in forum: Perl
    Replies:
    5
    Views:
    516
  2. Darrel
    Replies:
    2
    Views:
    332
    Darrel
    Oct 23, 2004
  3. Ram
    Replies:
    3
    Views:
    428
    Barry Schwarz
    Mar 24, 2009
  4. Jacob JKW

    Arbitrarily Many Nested Loops

    Jacob JKW, Mar 30, 2006, in forum: Perl Misc
    Replies:
    18
    Views:
    232
    Tim Kazner
    Apr 1, 2006
  5. rh
    Replies:
    0
    Views:
    133
Loading...

Share This Page