Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Re: How to create XML tree from non-XML source

by GrandFather (Saint)
on Sep 10, 2008 at 02:22 UTC ( #710230=note: print w/replies, xml ) Need Help??


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

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

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://710230]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (4)
As of 2022-11-29 04:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?