package XML::Axk::SAX::BuildDOM2;
use strict;
use XML::Axk::DOM;
use Data::Dumper;

# TODO support namespaces

#use parent XML::SAX::Base; # TODO later

our $VERSION;
$VERSION = "1.50";

our $DEBUG = 0;

# TODO:
# - add support for parameter entity references
# - expand API: insert Elements in the tree or stuff into DocType etc.

sub new
{
    my ($class, %args) = @_;
    bless \%args, $class;
} #new()

#-------- PerlSAX Handler methods ------------------------------

sub start_document # was Init
{
    my $self = shift;

    # Define Document if it's not set & not obtainable from Element or DocType
    $self->{Document} ||=
        (defined $self->{Element} ? $self->{Element}->getOwnerDocument : undef)
     || (defined $self->{DocType} ? $self->{DocType}->getOwnerDocument : undef)
     || new XML::DOM::Document();

    $self->{Element} ||= $self->{Document};

    unless (defined $self->{DocType})
    {
        $self->{DocType} = $self->{Document}->getDoctype
        if defined $self->{Document};

        unless (defined $self->{Doctype})
        {
            #?? should be $doc->createDocType for extensibility!
            $self->{DocType} = new XML::DOM::DocumentType ($self->{Document});
            $self->{Document}->setDoctype ($self->{DocType});
        }
    }

    # Prepare for document prolog
    $self->{InProlog} = 1;

    # We haven't passed the root element yet
    $self->{EndDoc} = 0;

    undef $self->{LastText};
} #start_document()

sub end_document # was Final
{
    my $self = shift;
    unless ($self->{SawDocType})
    {
        my $doctype = $self->{Document}->removeDoctype;
        $doctype->dispose;
        #?? do we always want to destroy the Doctype?
    }
    $self->{Document};
} #end_document()

sub characters # was Char
{
    my $self = $_[0];
    my $str = $_[1]->{Data};

    if ($self->{InCDATA} && $self->{KeepCDATA})
    {
        undef $self->{LastText};
        # Merge text with previous node if possible
        $self->{Element}->addCDATA ($str);
    }
    else
    {
        # Merge text with previous node if possible
        # Used to be: $expat->{DOM_Element}->addText ($str);
        if ($self->{LastText})
        {
            $self->{LastText}->appendData ($str);
        }
        else
        {
            $self->{LastText} = $self->{Document}->createTextNode ($str);
            $self->{Element}->appendChild ($self->{LastText});
        }
    }
} #characters()

sub start_element # was Start
{
    my ($self, $hash) = @_;
    my $elem = $hash->{Name};
    my $attr = $hash->{Attributes};
    print "start_element:\n", Dumper($hash) if $DEBUG;

    my $parent = $self->{Element};
    my $doc = $self->{Document};

    if ($parent == $doc)
    {
        # End of document prolog, i.e. start of first Element
        $self->{InProlog} = 0;
    }

    undef $self->{LastText};
    my $node = $doc->createElement ($elem);
    $self->{Element} = $node;
    $parent->appendChild ($node);

    my $i = 0;
    my $n = scalar keys %$attr;
    return unless $n;

    if (exists $hash->{AttributeOrder})
    {
        my $defaulted = $hash->{Defaulted};
        my @order = @{ $hash->{AttributeOrder} };

        # Specified attributes
        for (my $i = 0; $i < $defaulted; $i++)
        {
            my $a = $order[$i];
            my $att = $doc->createAttribute ($attr->{$a}->{LocalName},
                $attr->{$a}->{Value}, 1);
            $node->setAttributeNode ($att);
        }

        # Defaulted attributes
        for (my $i = $defaulted; $i < @order; $i++)
        {
            my $a = $order[$i];
            die "Defaulted attributes not supported!";
                # Because I don't know what to do with them.
            my $att = $doc->createAttribute ($elem, $attr->{$a}->{LocalName}, 0);
            $node->setAttributeNode ($att);
        }
    }
    else
    {
        # We're assuming that all attributes were specified (1)
        for my $a (keys %$attr)
        {
            my $att = $doc->createAttribute ($attr->{$a}->{LocalName},
                $attr->{$a}->{Value}, 1);
            $node->setAttributeNode ($att);
        }
    }
} #start_element()

sub end_element
{
    my $self = shift;
    $self->{Element} = $self->{Element}->getParentNode;
    undef $self->{LastText};

    # Check for end of root element
    $self->{EndDoc} = 1 if ($self->{Element} == $self->{Document});
} #end_element

sub entity_reference # was Default
{
    my $self = $_[0];
    my $name = $_[1]->{Name};

    $self->{Element}->appendChild (
                            $self->{Document}->createEntityReference ($name));
    undef $self->{LastText};
} #entity_reference()

sub start_cdata
{
    my $self = shift;
    $self->{InCDATA} = 1;
} #start_cdata()

sub end_cdata
{
    my $self = shift;
    $self->{InCDATA} = 0;
} #end_cdata()

sub comment
{
    my $self = $_[0];

    local $XML::DOM::IgnoreReadOnly = 1;

    undef $self->{LastText};
    my $comment = $self->{Document}->createComment ($_[1]->{Data});
    $self->{Element}->appendChild ($comment);
} #comment()

sub doctype_decl
{
    my ($self, $hash) = @_;

    $self->{DocType}->setParams ($hash->{Name}, $hash->{SystemId},
                                 $hash->{PublicId}, $hash->{Internal});
    $self->{SawDocType} = 1;
} #doctype_decl()

sub attlist_decl
{
    my ($self, $hash) = @_;

    local $XML::DOM::IgnoreReadOnly = 1;

    $self->{DocType}->addAttDef ($hash->{ElementName},
                                 $hash->{AttributeName},
                                 $hash->{Type},
                                 $hash->{Default},
                                 $hash->{Fixed});
} #attlist_decl()

sub xml_decl
{
    my ($self, $hash) = @_;

    local $XML::DOM::IgnoreReadOnly = 1;

    undef $self->{LastText};
    $self->{Document}->setXMLDecl (new XML::DOM::XMLDecl ($self->{Document},
                                                          $hash->{Version},
                                                          $hash->{Encoding},
                                                          $hash->{Standalone}));
} #xml_decl()

sub entity_decl
{
    my ($self, $hash) = @_;

    local $XML::DOM::IgnoreReadOnly = 1;

    # Parameter Entities names are passed starting with '%'
    my $parameter = 0;

    #?? parameter entities currently not supported by PerlSAX!

    undef $self->{LastText};
    $self->{DocType}->addEntity ($parameter, $hash->{Name}, $hash->{Value},
                                 $hash->{SystemId}, $hash->{PublicId},
                                 $hash->{Notation});
} #entity_decl()

# Unparsed is called when it encounters e.g:
#
#   <!ENTITY logo SYSTEM "http://server/logo.gif" NDATA gif>
#
sub unparsed_decl
{
    my ($self, $hash) = @_;

    local $XML::DOM::IgnoreReadOnly = 1;

    # same as regular ENTITY, as far as DOM is concerned
    $self->entity_decl ($hash);
} #unparsed_decl()

sub element_decl
{
    my ($self, $hash) = @_;

    local $XML::DOM::IgnoreReadOnly = 1;

    undef $self->{LastText};
    $self->{DocType}->addElementDecl ($hash->{Name}, $hash->{Model});
} #element_decl()

sub notation_decl
{
    my ($self, $hash) = @_;

    local $XML::DOM::IgnoreReadOnly = 1;

    undef $self->{LastText};
    $self->{DocType}->addNotation ($hash->{Name}, $hash->{Base},
                                   $hash->{SystemId}, $hash->{PublicId});
} #notation_decl()

sub processing_instruction
{
    my ($self, $hash) = @_;

    local $XML::DOM::IgnoreReadOnly = 1;

    undef $self->{LastText};
    $self->{Element}->appendChild (new XML::DOM::ProcessingInstruction
                        ($self->{Document}, $hash->{Target}, $hash->{Data}));
} #processing_instruction()

return 1;

__END__

=head1 NAME

XML::Handler::BuildDOM - PerlSAX handler that creates XML::DOM document structures

=head1 SYNOPSIS

 use XML::Handler::BuildDOM;
 use XML::Parser::PerlSAX;

 my $handler = new XML::Handler::BuildDOM (KeepCDATA => 1);
 my $parser = new XML::Parser::PerlSAX (Handler => $handler);

 my $doc = $parser->parsefile ("file.xml");

=head1 DESCRIPTION

XML::Handler::BuildDOM creates L<XML::DOM> document structures
(i.e. L<XML::DOM::Document>) from PerlSAX events.

This class used to be called L<XML::PerlSAX::DOM> prior to libxml-enno 1.0.1.

=head2 CONSTRUCTOR OPTIONS

The XML::Handler::BuildDOM constructor supports the following options:

=over 4

=item * KeepCDATA => 1

If set to 0 (default), CDATASections will be converted to regular text.

=item * Document => $doc

If undefined, start_document will extract it from Element or DocType (if set),
otherwise it will create a new XML::DOM::Document.

=item * Element => $elem

If undefined, it is set to Document. This will be the insertion point (or parent)
for the nodes defined by the following callbacks.

=item * DocType => $doctype

If undefined, start_document will extract it from Document (if possible).
Otherwise it adds a new XML::DOM::DocumentType to the Document.

=back

=cut
# vi: set ts=4 sts=4 sw=4 et ai: #
