Excalibor has asked for the wisdom of the Perl Monks concerning the following question:

Hello, fellow monks!

I have to represent a dependency graph before inserting a new attribute value into an LDAP server. It's actually that objectClasses have a kind of IS-A dependencies... I thought that a hash of hashes of hashes of... could do the trick, but I am having a serious problem.

It's shown in the following code:

# small example
my $tree = {
    top => {
        inetUser => {},
        person => {
        organizationalPerson => {
            managedPerson => {
                personnel => {}, }, }, },
        application => {
            managedApplication => {}, }, },
 };

# I need to get the nodes that lead to the one I am looking for
sub explore
{
    my $node = shift;
    my $target = shift;
    my $stack = shift;

    # we found it, so we may leave...
    return $stack if $target eq $stack->[-1];
    # we keep looking...
    my $kids = scalar keys %$node;
    if ( $kids > 0 )
    {
        for my $key ( keys %$node )
        {
            push @$stack, $key;
            show( $stack );
            explore( $node->{$key}, $target, $stack, $OK );
            pop @$stack;
        }
    }
    else
    {  # leaf... no-op
    }
}

sub show { print "$_ " for @{$_[0]}; print "\n" }

# test
my $stack;
eval
{
    explore( $tree, 'personnel', [] );
    # expected result: "top person organizationalPerson managedPerson 
+personnel ";
};
$stack = $@;
show( $stack );
__END__

[download]

This works OK, but it's rather an ugly hack... Any way to do this without the exception? thanks!

--
our $Perl6 is Fantastic;

Replies are listed 'Best First'.
Re: trees and depth-first search
by BrowserUk (Patriarch) on Oct 27, 2004 at 14:55 UTC

    Something like this? 

    #! perl -slw
use strict;
$|=1;

my $tree = {
    top => {
        inetUser => {},
        person => {
            organizationalPerson => {
                managedPerson => {
                    personnel => {}, 
                }, 
            }, 
         },
        application => {
            managedApplication => {}, 
        }, 
    },
 };
 
sub explore;
sub explore {
    my( $tree, $leaf ) = @_;
    for my $node ( keys %$tree ){
        return $node if $node eq $leaf;
        next unless keys %{ $tree->{ $node } };
        my @found = explore $tree->{ $node }, $leaf;
        return ( $node, @found ) if @found;
    }
    return;
}

printf "Looking for %-20s: %s\n", $_, join ' -> ', explore $tree, $_ 
    for qw[ fred inetUser managedApplication personnel ];
    
__END__
P:\test>test
Looking for fred                :
Looking for inetUser            : top -> inetUser
Looking for managedApplication  : top -> application -> managedApplica
+tion
Looking for personnel           : 
    top -> person -> organizationalPerson -> managedPerson -> personne
+l

    [download]
    Examine what is said, not who speaks.
    "Efficiency is intelligent laziness." -David Dunham
    "Think for yourself!" - Abigail
    "Memory, processor, disk in that order on the hardware side. Algorithm, algorithm, algorithm on the code side." - tachyon
[reply]
[d/l]

      Exactly like that, thank you! :-)

      PS: It's really elegant, I don't think I would have gotten it so cool (and now I see the 'proper' stack unwinding returning values... silly me... Thanks for the great leson!)

      --
      our $Perl6 is Fantastic;

[reply]
[d/l]
Re: trees and depth-first search
by insaniac (Friar) on Oct 27, 2004 at 14:52 UTC
    hi
    when i first ran your code, i saw too much output... so i changed the return into an exit 0 and i moved your show ( $stack ) into that if code block...
    something like this:
    my $tree = {
    top => {
        inetUser => {},
        person => {
            organizationalPerson => {
                managedPerson => {
                    personnel => {},
                },
            },
        },
        application => {
            managedApplication => {},
        },
    },
 };

sub explore
{
    my $node = shift;
    my $target = shift;
    my $stack = shift;

    if( $target eq $stack->[$#stack]) {
        show( $stack );
        exit 0;
    }
    my $kids = scalar keys %$node;
    if ( $kids > 0 )
    {
        for my $key ( keys %$node )
        {
            push @$stack, $key;
            explore( $node->{$key}, $target, $stack, $OK );
            pop @$stack;
        }
    }
}

sub show { print "$_ " for @{$_[0]}; print "\n" }

my $stack;
explore( $tree, 'personnel', []);

    [download]

    oh yeah, i also removed the last two lines of your, since i had no idea what they do... but as it seems: they were not required ;-)
    when you run the above code you really get: 
    insaniac][r0nin: ~/work/code/perl : perl tree_ldap.pl
top person organizationalPerson managedPerson personnel

    [download]

    hope this helps a little bit..

    Update: also removed the eval ;-)

    --
    to ask a question is a moment of shame
    to remain ignorant is a lifelong shame
[reply]
[d/l]
[select]
Re: trees and depth-first search
by LanceDeeply (Chaplain) on Oct 27, 2004 at 14:52 UTC
    are you confined to representing your tree that way? i've done some basic relationship traversals using a hash of node objects, each referring to it's parent. you can then just lookup the node you want and do a recursive call up the parent chain like so: 
    package Node;

use strict;
use warnings;


sub new
{
    my $self  = bless( {}, shift );
    my $name = shift;
    $self->name($name);
    return $self;
}

sub name
{
    my $self = shift;
    @_ ? $self->{name} = shift : $self->{name};
}

sub parent
{
    my $self = shift;
    @_ ? $self->{parent} = shift : $self->{parent};
}

sub ancestory
{
    my $self = shift;
    my $decendants = shift || ();
    my $name = $self->name();
    unshift @{$decendants}, $self->name();
    my $parent = $self->parent();
    $parent ? $parent->ancestory($decendants) : $decendants;
}



my %Nodes;

sub GetNode
{
    my $nodeName = shift;
    if ( ! $Nodes{$nodeName} )
    {
        $Nodes{$nodeName} = new Node($nodeName);
    }
    return $Nodes{$nodeName};
    
}

#
#   load relationships
#
while (<DATA>)
{
    chomp;
    my ($parentName,$childName) = split ",",$_ ;
    my $parentNode = GetNode($parentName);
    my $childNode = GetNode($childName);
    $childNode->parent($parentNode)
}

#
#   print path to the node you are looking for
#
print join " ", @{GetNode("managedApplication")->ancestory()};
print "\n";
print join " ", @{GetNode("personnel")->ancestory()};
print "\n";


__DATA__
top,inetUser
top,person
top,application
person,organizationalPerson
application,managedApplication
organizationalPerson,managedPerson
managedPerson,personnel

    [download]
    produces: 
    top application managedApplication
top person organizationalPerson managedPerson personnel

    [download]
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom