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