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
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>
Perl reduces RSI - it saves typing
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.
|