Update: Or more compactly. Use as below.

sub x {
    my $aref = shift;
    my( $name, @kids ) = @_;
    push @{ $aref }, { name => $name }
        unless @$aref and $aref->[ -1 ]{ name } eq $name;
    x( $aref->[ -1 ]{ children } ||= [], @kids ) if @kids;
}
[download]

#! perl -slw
use strict;
use Data::Dumper;

sub x {
    my $aref = shift;
    my( $name, @kids ) = @_;
    unless( @$aref and $aref->[ -1 ]{ name } eq $name ) {
        push @{ $aref }, { name => $name };
    }
    if( @kids ) {
        if( not exists $aref->[ -1 ]{ children } ) {
            $aref->[ -1 ]{ children } = [];
        }
        x( $aref->[ -1 ]{ children }, @kids );
    }
}

my @data;
chomp() and x( \@data, split ' / ', $_ ) while <DATA>;

print Dumper \@data;

__DATA__
one
foo / bar
foo / baz
foo / qux / two
foo / qux / three
foo / qux / four
five
[download]

Produces

c:\test>junk9 | more
$VAR1 = [
          {
            'name' => 'one'
          },
          {
            'name' => 'foo',
            'children' => [
                            {
                              'name' => 'bar'
                            },
                            {
                              'name' => 'baz'
                            },
                            {
                              'name' => 'qux',
                              'children' => [
                                              {
                                                'name' => 'two'
                                              },
                                              {
                                                'name' => 'three'
                                              },
                                              {
                                                'name' => 'four'
                                              }
                                            ]
                            }
                          ]
          },
          {
            'name' => 'five'
          }
        ];
[download]

Perhaps Recursively walk a hash to get to an element would serve as a good starting point.

Update: I'm sure it could be done, but probably tougher than necessary. So here's a solution from scratch:

use strict;
use warnings;

my @d; # the data structure we're building.

my @p; # current (actually previous) vector

while (<DATA>)
{
    chomp;
    my $r = \@d;
    my @vc = my @v = split m# / #;
    my @pc = @p; # bashable copy
    while ( @vc and @pc and $vc[0] eq $pc[0] )
    {
        shift @vc; shift @pc;
        $r = $r->[-1]{'children'};
    }
    while ( @vc )
    {
        push @$r, { name => shift @vc };
        $r = ( @vc and $r->[-1]{'children'} = [] );
    }
    @p = @v;
}

use Data::Dumper;
print Dumper \@d;

__DATA__
one
foo / bar
foo / baz
foo / qux / two
foo / qux / three
foo / qux / four
five
[download]

Note, this presumes that the input lines are in proper order, as they are in your example data.

The name keys seem redundant to me. If you want to generate a nested hash structure based on the key strings then the following (non-recursive) code may get you started:

use strict;
use warnings;
use Data::Dump::Streamer;

my %hash;

while (<DATA>) {
    chomp;
    my @elements = split /\s*\/\s*/;
    
    next if ! @elements;
    
    $hash{$elements[0]} = {} if ! exists $hash{$elements[0]};
    my $subHash = $hash{shift @elements};
    
    for (@elements) {
        $subHash->{$_} = {} unless exists $subHash->{$_};
        $subHash = $subHash->{$_};
    };
}

Dump \%hash;

__DATA__
one
foo / bar
foo / baz
foo / qux / two
foo / qux / three
foo / qux / four
five
[download]

Prints:

$HASH1 = {
           five => {},
           foo  => {
                     bar => {},
                     baz => {},
                     qux => {
                              four  => {},
                              three => {},
                              two   => {}
                            }
                   },
           one  => {}
         };
[download]

The output will be used in an HTML::Template loop, so the name keys are required. Thanks for trying anyways, but the output I gave is what I need, and this won't work for me. :(

Well why didn't you say so?

use strict;
use warnings;
use HTML::Template;

use strict;
use warnings;
use Data::Dump::Streamer;

my %hash;

while (<DATA>) {
    chomp;
    my @elements = split /\s*\/\s*/;
   
    next if ! @elements;
   
    $hash{$elements[0]} = {} if ! exists $hash{$elements[0]};
    my $subHash = $hash{shift @elements};
   
    for (@elements) {
        $subHash->{$_} = {} unless exists $subHash->{$_};
        $subHash = $subHash->{$_};
    };
}

my @tree;

push @tree, buildFamily (\%hash, $_) for keys %hash;

my $template = <<'HTML';
  <html>
  <head><title>Test Template</title>
  <body><TMPL_LOOP NAME="Parents">
        Parent: <TMPL_VAR NAME="name"><br>
        <TMPL_LOOP NAME="children">   Child: <TMPL_VAR NAME="name"><br
+>
            <TMPL_LOOP NAME="children">   Grandchild: <TMPL_VAR NAME="
+name"><br>
        </TMPL_LOOP></TMPL_LOOP></TMPL_LOOP></body>
  </html>
HTML

my $t = HTML::Template->new (scalarref => \$template);

$t->param (Parents => \@tree);

print $t->output ();


sub buildFamily {
    my ($hash, $parent) = @_;
    my %root = (name => $parent);
    
    if (keys %{$hash->{$parent}}) {
        my @children;
        
        push @children, buildFamily ($hash->{$parent}, $_)
            for keys %{$hash->{$parent}};
            
        $root{children} = \@children;
    }
    
    return \%root;
}

__DATA__
one
foo / bar
foo / baz
foo / qux / two
foo / qux / three
foo / qux / four
five
[download]

Prints:

  <html>
  <head><title>Test Template</title>
  <body>
        Parent: five<br>
        
        Parent: one<br>
        
        Parent: foo<br>
           Child: bar<br>
               Child: baz<br>
               Child: qux<br>
               Grandchild: three<br>
           Grandchild: two<br>
           Grandchild: four<br>
        </body>
  </html>
[download]

---

DWIM is Perl's answer to Gödel

my @result;
while( <> ) {
   chomp();
   my @fld = split /\s*\/\s*/;
   InsertFlds( \@result, @fld );
}

sub InsertFlds {
   my $aref = shift;
   my $name = shift;
   defined ($aref -> [ $#$aref ]{ name }) or push @$aref, { name => $n
+ame };
   if ( @_ ) {
      $aref -> [ $#$aref ]{ children } ||= [];
      InsertFlds( $aref -> [$#$aref ]{ children }, @_ );
   }
}
[download]

After popping to the right level, and BEFORE pushing the current node, insert information from the current node into the array owned by the current stack top.

Your nodes are ok, except that I would add level to name and children. Also, add a dummy root node at level 0.

Phil

I followed you all the way up until the fifth sentance:

"If the current level is the same as the level of the element on top of the stack ..."

What is the "element" you are talking about? What are you storing in the stack? How can I attach children using this method?

Thanks.

Perhaps I should show a bit of code...

my @stack = { name => 'root', level => 0, children => [] };

foreach my $input ( @inputs ) {
    my @pieces = split /\s+\/\s+/, $input;
    my $level  = scalar @pieces;

    my $new_node = { name => pieces[-1], level => $level };

    if ( $level == $stack[-1]{level} ) {
        pop @stack;
    }
    elsif ( $level < $stack[-1]{level} ) {
        pop @stack while ( $level <= $stack[-1]{level} );
    }
    # else top level must be our parent
    push @stack[-1]{children}, $new_node;

    push @stack, $new_node
}
[download]

I wrote this up a few years ago.

Phil

%foo = (one => 1,
    foo => { bar => 1,
        # etc.
    }
);
[download]

use strict;
use warnings;

use Data::Dumper qw( Dumper );

my %tree;

while (<DATA>) {
   chomp;
   my $p = \%tree;
   foreach (split(qr{\s*/\s*}, $_)) {
      $p = $p->{$_} ||= {};
   }
}

print Dumper \%tree;

__DATA__
one
foo / bar
foo / baz
foo / qux / two
foo / qux / three
foo / qux / four
five
[download]

A little recursive sub to compile this into the right format:

use strict;
use warnings;

use Data::Dumper qw( Dumper );

my %tree;

while (<DATA>) {
   chomp;
   my $p = \%tree;
   foreach (split(qr{\s*/\s*}, $_)) {
      $p = $p->{$_} ||= {};
   }
}

sub re_format {
    my $data = shift;
    my $out = [];
    for my $key (keys %$data) {
        my $temp = { name => $key};
        if (keys %{ $data->{$key} }) {
           $temp->{children} = re_format($data->{$key})
        }
        push @$out, $temp;
    }
    return $out;
}    

print Dumper('First Step' => \%tree, 'Final' => re_format(\%tree));

__DATA__
one
foo / bar
foo / baz
foo / qux / two
foo / qux / three
foo / qux / four
five
[download]


___________
Eric Hodges

Are you suggesting that with a few modifications that I can use your code snippet to achieve my goal? Because I don't see how I can push the children onto their parents using your code (which doesn't produce the output I need).

But thanks anyways -- good ideas in there.

Well, I am quite scatter-brained at the moment. Under more ideal circumstances, I would "sleep on this problem" and solve it in the morning -- but I have to get this part done ASAP so I can continue with the larger task at hand.

As such I keep tearing down my past efforts -- but just so you know I am working on this instead of just waiting for others to do my work for me ...

sub recurse {
    my ($ref, $car, @cdr) = @_;

    if ($prev_car eq $car) {
        my $hash = { name => $car, children => [] };
        push @$ref, $hash;

        return unless @cdr;
        $prev_car = $car;
        recurse($hash->{children}, @cdr);
    }

    push @$ref, { name => $car, children => [] };

    return unless @cdr;
    $prev_car = $car;
    recurse($ref, @cdr);
}
[download]

Which produces the following output:
Read more... (3 kB)
I forgot to say "Thanks in advance" too. :)

If your keys are well-behaved, then this will do the trick:

while (<>) {
    chomp;
    s!\s*/\s*!}{!g;
    eval "\$h\{$_\} = 1;";
}
[download]