in reply to Need help with filling a complicated data structure

Or this: 

use strict;
use warnings;
use List::Util qw/max/;
use Data::Dumper;

my %type = ( '*' => 'u', '#' => 'o' );
sub type { $type{ substr shift, -1 } }

my @lines = map { /([*#]*)(\d*)\s+(.*)/; $2?[$1,[$3,{value=>$2}]]:[$1,
+$3] } <DATA>;
my $maxlevel = max map { length $_->[0] } @lines;
while( $maxlevel ) {
  my @indices = grep { $maxlevel == length $lines[$_]->[0] } 0..@lines
+-1;
  while( @indices ) {
    my $end = pop @indices;
    my $start = $end;
    $start = pop @indices while @indices and $indices[-1]==$start-1;
    my $sublist = [ type($lines[$start]->[0]), [ map { $_->[1] } splic
+e @lines, $start, $end-$start+1 ] ];
    $lines[$start-1]->[1] = [ $lines[$start-1]->[1], $sublist ] if $ma
+xlevel>1;
    splice @lines, $start, 0, $sublist if $maxlevel==1;
  }
  $maxlevel--;
}
@lines = grep { $_->[0] } @lines;

print Dumper \@lines;

__DATA__
* list 1 unordered item 1)
* list 1 unordered item 2
*# list 1 unordered item 2 ordered item 1
*# list 1 unordered item 2 ordered item 2
*# list 1 unordered item 2 ordered item 3
* list 1 unordered item 3
** list 1 unordered item unordered item 1
** list 1 unordered item unordered item 2
** list 1 unordered item unordered item 3
**# list 1 unordered item unordered item 3 ordered item 1
**# list 1 unordered item unordered item 3 ordered item 2
**# list 1 unordered item unordered item 3 ordered item 3
* list 1 unordered item 4

# list 2 ordered item 1
#3 list 2 ordered item 2
# list 2 ordered item 3
#* list 2 ordered item 3 unordered item 1
#* list 2 ordered item 3 unordered item 2
#* list 2 ordered item 3 unordered item 3
# list 2 ordered item 4

[download]

Replies are listed 'Best First'.
Re^2: Need help with filling a complicated data structure
by Lady_Aleena (Priest) on Nov 17, 2013 at 16:45 UTC

    Thanks hdb for trying to help, however, I can't see how to add your solves to the following.

    sub story {
  my ($source, $doc_magic, $line_magic) = @_;
  
  my $inc = 0;
  my @sections;
  my @toc;
  while (my $line = <$source>) {
    chomp($line);
    next if !$line;
    
    if ($line =~ /^2/) {
      my ($number,$text) = split(/ /,$line,2);
      push @toc, anchor(textify($text), { href => '#'.idify($text) });
      $inc++;
    }
    
    push @{$sections[$inc]}, $line;
  }

  my $tab = 3;
  $inc = 0;
  for my $section (@sections) {
    if ($section) {
      section($tab, sub {
        $tab++;
        for my $line (@{$section}) {
          my $line = convert_string($line, $line_magic);
          
          line($tab, $line),     next if $line =~ /^</;
          line($tab, "<$line>"), next if $line =~ /^[bh]r$/;
          $doc_magic->{$1}->(),      next if $line =~ /^&\s+(.*)/;
          blockquote($tab, $1),  next if $line =~ /^bq\s(.*)/;
          item($tab + 1, $1),    next if $line =~ /^\*\s(.*)/;
          item($tab + 1, $2, { value => $1 }), next if $line =~ /^\*(\
+d+)\s(.*)/;
          item($tab + 1, "<strong>$1</strong> $2"), next if $line =~ /
+^\*s\s(.+\:)\s(.*)$/;
          row($tab + 1, $1, row_line($2)), next if $line =~ /^\|\s(.+)
+\s\|\|(.+)$/;
          heading($tab, $1, $2, { id => idify($2) }),    next if $line
+ =~ /^([1-6])\s+(.*)/;
          paragraph($tab, $line, { class => 'author' }), next if $line
+ =~ /^by /;
          paragraph($tab, $line);
        }
        $tab--;
      });
    }
    if ($inc == 0 && @toc > 3) {
      section($tab, sub {
        my $class = @toc > 25 ? @toc > 50 ? 'four' : 'three' : 'two';
        my $style = @toc > 50 ? 'font-size:smaller' : undef;
        list($tab + 1, 'u', \@toc, { class => $class, style => $style 
+});
      }, { class => 'contents'} );
    }
    $inc++;
  }
  
#  paragraph($tab,"written by $root_user", { class => 'author' });
}

    [download]

    The lists will more than likely always be mixed in with other things like:

    __DATA__
2 This is a heading.
by An Author
This is just an opening paragraph, probably about the list.
* list 1 unordered item 1
* list 1 unordered item 2
*# list 1 unordered item 2 ordered item 1
*# list 1 unordered item 2 ordered item 2
*# list 1 unordered item 2 ordered item 3
* list 1 unordered item 3
** list 1 unordered item unordered item 1
** list 1 unordered item unordered item 2
** list 1 unordered item unordered item 3
**# list 1 unordered item unordered item 3 ordered item 1
**# list 1 unordered item unordered item 3 ordered item 2
**# list 1 unordered item unordered item 3 ordered item 3
* list 1 unordered item 4
hr
This is another paragraph about the list below it.
# list 2 ordered item 1
#3 list 2 ordered item 2
# list 2 ordered item 3
#* list 2 ordered item 3 unordered item 1
#* list 2 ordered item 3 unordered item 2
#* list 2 ordered item 3 unordered item 3
# list 2 ordered item 4
bq This is a quote
by Quote Author
Any maybe some final remarks.
& a little magic

    [download]

    (I'm having a bad weekend all around, nothing is sinking in.)

    No matter how hysterical I get, my problems are not time sensitive. So, relax, have a cookie, and a very nice day!
    Lady Aleena
[reply]
[d/l]
[select]

      Similar to ig's proposal below, I would collect the lines belonging to a list and then call a sub that processes the lines of the list. 

      ...
$tab++;
my @list;
for my $line (@{$section}) {
    my $line = convert_string($line, $line_magic);
    
    if( $line =~ /^[*#]+ / ) {
        push @list, $line;
        next;
    } else {
        process_list( @list ) if @list;
        @list = ();
    }
    line($tab, $line),     next if $line =~ /^</;
    ...

      [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom