#!/usr/bin/perl -w
BEGIN
{
    use strict;
    use warnings;
};

my $dom = minidom::document->new( '<root att1="1" id="r-1">
    <kid att1="1" att2="vv" id="k-1">
        <gkid1 att2="vv" id="gk1-1">vgkid1-1</gkid1>
        <gkid2 att2="vx" id="gk2-1">vgkid2-1</gkid2>
    </kid>
    <kid att1="2" att2="vv" id="k-2">
        <gkid1 att2="vv" id="gk1-2">vgkid1-2</gkid1>
        <gkid2 att2="vx" id="gk2-2">vgkid2-2</gkid2>
    </kid>
    <kid att1="3" att2="vv" id="k-3">
        <gkid1 att2="vv" id="gk1-3">vgkid1-3</gkid1>
        <gkid2 att2="vx" id="gk2-3">vgkid2-3</gkid2>
    </kid>
    <kid att1="4" att2="vv" id="k-4">
        <gkid1 att2="vv" id="gk1-4">vgkid1-4</gkid1>
        <gkid2 att2="vx" id="gk2-4">vgkid2-4</gkid2>
    </kid>
    <!-- a comment -->
    <kid att1="5" att2="vv" id="k-5">
        <gkid1 att2="vv" id="gk1-5">vg <!-- an other comment -->kid1-5</gkid1>
        <gkid2 att2="vx" id="gk2-5">vgkid2-5</gkid2>
    </kid>
</root>' );

# use Data::Dumper;
# print Dumper $dom;

package minidom::node;

my $parent = 0;
my $pos = 1;
my $rank = 2;

sub isElementNode {}
sub isAttributeNode {}
sub isNamespaceNode {}
sub isTextNode {}
sub isProcessingInstructionNode {}
sub isPINode {}
sub isCommentNode {}
  
sub getParentNode { return( $_[0]->[ $parent ] ); }
sub pos { return( $_[0]->[ $pos ] ); }
sub getRootNode
{
    my $self = shift( @_ );
    while( my $parent = $self->getParentNode )
    {
        $self = $parent;
    }
    return( $self );
}
sub getChildNodes { return( wantarray() ? () : [] ); }

sub getAttributes { return( wantarray() ? () : [] ); }

sub getPreviousSibling
{
    my $self = shift( @_ );
    my $rank = $self->[ $rank ];
    return unless( $self->[ $parent ] );
    return( $rank ? $self->[ $parent ]->getChildNode( $rank - 1 ) : undef );
}

sub getNextSibling
{
    my $self = shift( @_ );
    my $rank = $self->[ $rank ];
    return unless $self->[ $parent ];
    return( $self->[ $parent ]->getChildNode( $rank + 1 ) );
}

sub getChildNode { return }

package minidom::document;
use parent -norequire, qw( minidom::node );

sub new
{
    my( $class, $string ) = @_;
    ( my $base_class = $class ) =~ s{::[^:]*$}{};
    my $i = 0;
    $string =~ s{<!--(.*?)-->}{[[ bless( [ '$1'], '${base_class}::comment') ]]}sg;
    $string =~ s{<\?(\w+)(.*?)\?>}{[[ bless( [ '$1', '$2'], '${base_class}::pi') ]]}sg;
    while( $string =~ m{^<} )
    {
        $string =~ s{<([^/>]*)>([^<]*)</([^>]*)>}
        {
            parse_elt( $base_class, $1, $2, $3 );
        }eg;
    }
    # remove marker before root
    $string =~ s{\[\[}{\[}g;
    # after
    $string =~ s{\]\]}{\],}g;

    my $data = eval( $string );
    my $self = bless( $data, $class );
    $self->add_pos_parent();
    return( $self );
}

{
    my $pos;
    sub add_pos_parent
    {
        my $self = shift( @_ );
        unless( $pos )
        {
            unshift( @$self, undef, ++$pos, 0 );
        }
        my @children = @$self;
        # shift( @children );
        # shift( @children );
        # shift( @children );
        splice( @children, 0, 3 );
        my $rank = 1;
        foreach my $child ( @children )
        {
            if( UNIVERSAL::isa( $child, 'ARRAY' ) )
            {
                warn( "adding pos ($pos) and parent for $child->[0] (", ref( $child ), ")\n" );
                unshift( @$child, $self, ++$pos, $rank++ );
                add_pos_parent( $child );
            }
        }
    }
}

sub parse_elt
{
    my( $base_class, $start_tag, $content, $end_tag ) = @_;
    $start_tag =~ s{^}{'};
    # after the first space, start the atts
    $start_tag =~ s{ }{', [};
    $start_tag =~ s{([\w:-]+)\s*=\s*("[^"]*"|'[^']')}
    {
        bless( [ "$1", $2 ], '${base_class}::attribute')
    }g;
    # end the atts, ready for content
    $start_tag =~ s{, $}{]};
    my @content = split( /(\[\[.*?\]\])/s, $content );
    foreach ( @content )
    {
        # embedded elements
        if( m{^\[\[} )
        {
            s{^\[\[}{};
            s{\]\]}{};
        } # remove '[[' 
        else
        {
            # text, quote it
            s{^}{bless( ['}s,
            s{$}{'], '${base_class}::text')}s;
        }
    }
    $content = join( ', ', @content );
    return( "[[ bless(  [ $start_tag, $content ], '${base_class}::element') ]]" );
}
    
package minidom::element;
use parent -norequire, qw( minidom::node );

my $attributes = 3;
my $content = 4;

sub getChildNode
{
    my( $self, $rank ) = @_;
    return( $self->[ $rank + $content ] );
}

sub getChildNodes
{
    my( $self, $rank ) = @_;
    my @content = @$self;
    foreach( 1..$content )
    {
        shift( @content );
    }
    return( wantarray() ? @content : \@content );
}

1;

__END__

