http://qs1969.pair.com?node_id=710230


in reply to How to create XML tree from non-XML source

You may find the following interesting to ponder:

use strict;
use warnings;
use Tree::DAG_Node;

my $root = Tree::DAG_Node->new ();
my $level = 0;
my $currMother = $root;

while (<DATA>) {
    chomp;
    s/^\s+//;
    my ($lineLevel, $tag, $tail) = split ' ', $_, 3;
    my $newDaughter;
    
    while ($lineLevel < $level) {
        $currMother = $currMother->mother ();
        --$level;
    }
    
    if ($lineLevel > $level) {
        $newDaughter = $currMother = $currMother->new_daughter ();
        die "Adjacent lines differ by more than one level at line $."
            if ++$level != $lineLevel;
    }
    
    $newDaughter = $currMother->new_daughter () unless $newDaughter;
    $newDaughter->name ($tag);
    $newDaughter->attribute ()->{data} = $tail;
}

print "<root>\n";
$root->walk_down ({callback => \&enterNode, callbackback => \&exitNode
+, _depth => 0});
print "</root>\n";


sub enterNode {
    my ($node, $options) = @_;
    
    return 1 if ! defined $node->{name};

    print ' ' x ($options->{_depth} * 3);
    print "<$node->{name}>";
    print $node->attribute ()->{data} if defined $node->attribute ()->
+{data};
    print "\n";
    return 1;
}


sub exitNode {
    my ($node, $options) = @_;

    return if ! defined $node->name ();

    print ' ' x ($options->{_depth} * 3);
    print "</$node->{name}>\n";
}


__DATA__
 0 HEAD 
 1 SOUR Reunion
 2 VERS V8.0
 2 CORP Leister Productions
 1 DEST Reunion
 1 DATE 11 FEB 2006
 1 FILE test
 1 GEDC 
 2 VERS 5.5
 1 CHAR MACINTOSH
 0 @I1@ INDI
 1 NAME Bob /Cox/
 1 SEX M
 1 FAMS @F1@
 1 CHAN 
 2 DATE 11 FEB 2006
 0 @I2@ INDI
 1 NAME Joann /Para/
 1 SEX F
 1 FAMS @F1@
 1 CHAN 
 2 DATE 11 FEB 2006
 0 @I3@ INDI
 1 NAME Bobby Jo /Cox/
 1 SEX M
 1 FAMC @F1@
 1 CHAN 
 2 DATE 11 FEB 2006
 0 @F1@ FAM
 1 HUSB @I1@
 1 WIFE @I2@
 1 MARR 
 1 CHIL @I3@
 0 TRLR

[download]

Prints:

<root>
   <HEAD>
   </HEAD>
   <SOUR>Reunion
      <VERS>V8.0
         <CORP>Leister Productions
         </CORP>
      </VERS>
      <DEST>Reunion
      </DEST>
      <DATE>11 FEB 2006
      </DATE>
      <FILE>test
      </FILE>
      <GEDC>
      </GEDC>
      <VERS>5.5
      </VERS>
      <CHAR>MACINTOSH
      </CHAR>
   </SOUR>
   <@I1@>INDI
   </@I1@>
   <NAME>Bob /Cox/
      <SEX>M
      </SEX>
      <FAMS>@F1@
      </FAMS>
      <CHAN>
      </CHAN>
      <DATE>11 FEB 2006
      </DATE>
   </NAME>
   <@I2@>INDI
   </@I2@>
   <NAME>Joann /Para/
      <SEX>F
      </SEX>
      <FAMS>@F1@
      </FAMS>
      <CHAN>
      </CHAN>
      <DATE>11 FEB 2006
      </DATE>
   </NAME>
   <@I3@>INDI
   </@I3@>
   <NAME>Bobby Jo /Cox/
      <SEX>M
      </SEX>
      <FAMC>@F1@
      </FAMC>
      <CHAN>
      </CHAN>
      <DATE>11 FEB 2006
      </DATE>
   </NAME>
   <@F1@>FAM
   </@F1@>
   <HUSB>@I1@
      <WIFE>@I2@
      </WIFE>
      <MARR>
      </MARR>
      <CHIL>@I3@
      </CHIL>
   </HUSB>
   <TRLR>
   </TRLR>
</root>

[download]
Perl reduces RSI - it saves typing

In Section Seekers of Perl Wisdom