1#!/usr/bin/perl -w 2 3use strict; 4use warnings; 5 6my $dom= minidom::document->new( '<root att1="1" id="r-1"> 7 <kid att1="1" att2="vv" id="k-1"> 8 <gkid1 att2="vv" id="gk1-1">vgkid1-1</gkid1> 9 <gkid2 att2="vx" id="gk2-1">vgkid2-1</gkid2> 10 </kid> 11 <kid att1="2" att2="vv" id="k-2"> 12 <gkid1 att2="vv" id="gk1-2">vgkid1-2</gkid1> 13 <gkid2 att2="vx" id="gk2-2">vgkid2-2</gkid2> 14 </kid> 15 <kid att1="3" att2="vv" id="k-3"> 16 <gkid1 att2="vv" id="gk1-3">vgkid1-3</gkid1> 17 <gkid2 att2="vx" id="gk2-3">vgkid2-3</gkid2> 18 </kid> 19 <kid att1="4" att2="vv" id="k-4"> 20 <gkid1 att2="vv" id="gk1-4">vgkid1-4</gkid1> 21 <gkid2 att2="vx" id="gk2-4">vgkid2-4</gkid2> 22 </kid> 23 <!-- a comment --> 24 <kid att1="5" att2="vv" id="k-5"> 25 <gkid1 att2="vv" id="gk1-5">vg <!-- an other comment -->kid1-5</gkid1> 26 <gkid2 att2="vx" id="gk2-5">vgkid2-5</gkid2> 27 </kid> 28</root>'); 29 30use Data::Dumper; 31print Dumper $dom; 32 33package minidom::node; 34 35my $parent=0; 36my $pos=1; 37my $rank=2; 38 39sub isElementNode {} 40sub isAttributeNode {} 41sub isNamespaceNode {} 42sub isTextNode {} 43sub isProcessingInstructionNode {} 44sub isPINode {} 45sub isCommentNode {} 46 47sub getParentNode { return $_[0]->[$parent]; } 48sub pos { return $_[0]->[$pos]; } 49sub getRootNode { 50 my $self = shift; 51 while (my $parent = $self->getParentNode) { 52 $self = $parent; 53 } 54 return $self; 55} 56sub getChildNodes { 57 return wantarray ? () : []; 58} 59sub getAttributes { 60 return wantarray ? () : []; 61} 62 63sub getPreviousSibling { 64 my $self = shift; 65 my $rank = $self->[$rank]; 66 return unless $self->[$parent]; 67 return $rank ? $self->[$parent]->getChildNode($rank-1) : undef; 68} 69 70sub getNextSibling { 71 my $self = shift; 72 my $rank = $self->[$rank]; 73 return unless $self->[$parent]; 74 return $self->[$parent]->getChildNode($rank+1); 75} 76 77sub getChildNode { return } 78 791; 80 81package minidom::document; 82use base 'minidom::node'; 83 84sub new 85 { my( $class, $string)= @_; 86 ( my $base_class= $class)=~ s{::[^:]*$}{}; 87 my $i=0; 88 $string=~ s{<!--(.*?)-->}{[[ bless( [ '$1'], '${base_class}::comment') ]]}sg; 89 $string=~ s{<\?(\w+)(.*?)\?>}{[[ bless( [ '$1', '$2'], '${base_class}::pi') ]]}sg; 90 while( $string=~ m{^<}) 91 { $string=~ s{<([^/>]*)>([^<]*)</([^>]*)>} 92 { parse_elt( $base_class, $1, $2, $3); }eg; 93 } 94 $string=~ s{\[\[}{\[}g; # remove marker before root 95 $string=~ s{\]\]}{\],}g; # after 96 97 my $data= eval( $string); 98 my $self= bless $data, $class; 99 $self->add_pos_parent(); 100 return $self; 101 } 102 103{ my $pos; 104sub add_pos_parent 105 { my( $self)= @_; 106 unless( $pos) { unshift @$self, undef, ++$pos, 0; } 107 my @children= @$self; shift @children; shift @children; shift @children; 108 my $rank=1; 109 foreach my $child (@children) 110 { if( UNIVERSAL::isa( $child, 'ARRAY')) 111 { warn "adding pos ($pos) and parent for $child->[0] (", ref($child), ")\n"; 112 unshift @$child, $self, ++$pos, $rank++; 113 add_pos_parent( $child) 114 } 115 } 116 } 117} 118 119sub parse_elt 120 { my( $base_class, $start_tag, $content, $end_tag)= @_; 121 $start_tag=~ s{^}{'}; 122 $start_tag=~ s{ }{', [}; # after the first space, start the atts 123 $start_tag=~ s{([\w:-]+)\s*=\s*("[^"]*"|'[^']')}{bless( [ "$1", $2 ], '${base_class}::attribute'), }g; 124 $start_tag=~ s{, $}{]}; # end the atts, ready for content 125 my @content= split /(\[\[.*?\]\])/s, $content; 126 foreach (@content) 127 { if( m{^\[\[}) # embedded elements 128 { s{^\[\[}{}; s{\]\]}{}; } # remove '[[' 129 else 130 { s{^}{bless( ['}s, s{$}{'], '${base_class}::text')}s; } # text, quote it 131 } 132 $content= join( ', ', @content); 133 return "[[ bless( [ $start_tag, $content ], '${base_class}::element') ]]"; 134 } 135 1361; 137 138package minidom::element; 139use base 'minidom::node'; 140 141my $attributes=3; 142my $content=4; 143 144sub getChildNode 145 { my( $self, $rank)= @_; 146 return $self->[$rank+$content]; 147 } 148 149sub getChildNodes 150 { my( $self, $rank)= @_; 151 my @content= @$self; 152 foreach( 1..$content) { shift @content; } 153 return wantarray ? @content : \@content; 154 } 155 156 157 1581; 159 160 161