package Common::XMLWriter;

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#   Copyright RoyaltyShare, Inc. 2005
#   All Rights Reserved.  Licensed Software.
#
#   THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF RoyaltyShare, Inc.
#   The copyright notice above does not evidence any actual or
#   intended publication of such source code.
#
#   PROPRIETARY INFORMATION, PROPERTY OF RoyaltyShare, Inc.
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#
#    $Id$
#    $Source$
#
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

# you can change these to empty strings to save file size and parse time.
use constant XML_INDENT_STRING => "  ";
use constant XML_NEWLINE       => "\n";

use strict;
use Carp;

#use warnings;

sub new {
    my ( $class, %args ) = @_;

    my $self = bless {}, $class;
    return $self->_init(%args);
}

sub _init {
    my ( $self, %args ) = @_;

    $self->{OPTIONS}      = \%args;
    $self->{XML_STR}      = "";
    $self->{INDENT}       = 0;
    $self->{TAGSTACK}     = [];
    $self->{CHARSETSTACK} = [];
    $self->{UTF8_INPUT}   = 1;

    return $self;
}

sub _addToXML {
    my ( $self, $stringToAdd ) = @_;

    # Seed the XML with the encoding pseudo-tag, if this is the first line.
    #
    if ( "" eq $self->{XML_STR} && !$self->{OPTIONS}{skip_definition} ) {
        my $encoding = ( $self->{UTF8_INPUT} ? 'utf-8' : 'iso-8859-1' );
        $self->{XML_STR} .= "<?xml version=\"1.0\" encoding=\"$encoding\" ?>" . XML_NEWLINE;
    }

    $self->{XML_STR} .= $stringToAdd if ( defined $stringToAdd );
}

# -----------------------------------------------
# sub: starttag
# -----------------------------------------------
#  in: string tag name , hashref of attributes
# out: n/a (updated xml string, tag stack)
# -----------------------------------------------
# Start a parent xml tag and increment the indent.
# Push new tag onto tag stack.
#
# Calling this:
#     $xw->starttag("song", "song_id"=>1234);
#
# Creates this:
#    <song song_id="1234">
# -----------------------------------------------
sub starttag {
    my ( $self, $tag, @params ) = @_;
    my $params = "";
    while (@params) {
        my $param    = shift @params;
        my $paramval = shift(@params);
        croak "must provide values for all params" unless defined $paramval;
        $params .= qq/ $param="/ . _mangle($paramval) . qq/"/;
    }

    # indent by the number of tags on the stack.
    my $indent = XML_INDENT_STRING x scalar( @{ $self->{TAGSTACK} } );

    # keep building the xml string
    $self->_addToXML( $indent . "<$tag$params>" . XML_NEWLINE );

    push @{ $self->{TAGSTACK} }, $tag;
}

# -----------------------------------------------
# sub: endtag
# -----------------------------------------------
#  in: string tag name
# out: n/a (updated strin, tag stack)
# -----------------------------------------------
# Print an xml end tag and decrement the indent.
# You don't need to provide the tag name (since
# we get it from the stack), but if you do, it
# will make sure they match.
#
# Calling this:
#     $xw->endtag("song");
#
# Creates this:
#    </song>
# -----------------------------------------------
sub endtag {
    my ( $self, $checktag ) = @_;
    my $tag = pop( @{ $self->{TAGSTACK} } );

    if ( defined($checktag) && $checktag ne $tag ) {
        croak "Tag mismatch... expected $tag, got $checktag";
    }

    my $indent = XML_INDENT_STRING x scalar( @{ $self->{TAGSTACK} } );
    $self->_addToXML( $indent . "</$tag>" . XML_NEWLINE );
}

# -----------------------------------------------
# sub: element
# -----------------------------------------------
#  in: string tag name, string tag value
# out: n/a (updated string, tag stack)
# -----------------------------------------------
# Prints an xml value enclosed in start and end
# tags.
#
# Calling this:
#     $xw->element("song" => "Old Brown Shoe");
#
# Creates this:
#    <song>Old Brown Show</song>
# -----------------------------------------------
sub element {
    my ( $self, $tag, $chars, @p ) = @_;

    # warn("tag element: $tag => $chars");
    my $indent = XML_INDENT_STRING x scalar( @{ $self->{TAGSTACK} } );

    my $params = "";
    while (@p) {
        my $param    = shift @p;
        my $paramval = shift(@p);
        croak "must provide values for all params" unless defined $paramval;
        $params .= qq/ $param="/ . _mangle($paramval) . qq/"/;
    }

    # keeping building the xml string
    $self->_addToXML( $indent . "<$tag$params>" );
    $self->_addToXML( $self->{UTF8_INPUT} ? _mangle_already_utf8($chars) : _mangle($chars) );
    $self->_addToXML( "</" . $tag . ">" . XML_NEWLINE );
}

# -----------------------------------------------
# sub: element_raw
# -----------------------------------------------
#  in: string tag name, string tag value
# out: n/a (updated string, tag stack)
# -----------------------------------------------
# Prints an xml value enclosed in start and end
# tags.
# Unlike the element method, element_raw _skips_ the mangle step.
# -----------------------------------------------
sub element_raw {
    my ( $self, $tag, $chars, @p ) = @_;

    # warn("tag element: $tag => $chars");
    my $indent = XML_INDENT_STRING x scalar( @{ $self->{TAGSTACK} } );

    my $params = "";
    while (@p) {
        my $param    = shift @p;
        my $paramval = shift(@p);
        croak "must provide values for all params" unless defined $paramval;
        $params .= qq/ $param="/ . _mangle($paramval) . qq/"/;
    }

    # keeping building the xml string
    $self->_addToXML( $indent . "<$tag$params>" );
    $self->_addToXML($chars);
    $self->_addToXML( "</" . $tag . ">" . XML_NEWLINE );
}

# -----------------------------------------------
# private sub: _mangle
# -----------------------------------------------
sub _mangle {
    my ( $package, $chars ) = @_;    # this is so you can call _mangle as a method
    $chars = $package if @_ == 1;    #    (for subclassing) or as a function.

    $chars =~ s/\&/\&amp;/g;
    $chars =~ s/</\&lt;/g;
    $chars =~ s/>/\&gt;/g;

    $chars =~ s/([\200-\377])/"&#".ord($1).";"/ge;

    return $chars;
}

# -----------------------------------------------
# private sub: _mangle_already_utf8
# -----------------------------------------------
sub _mangle_already_utf8 {
    my ( $package, $chars ) = @_;    # this is so you can call _mangle as a method
    $chars = $package if @_ == 1;    #    (for subclassing) or as a function.

    if ( defined $chars ) {
        $chars =~ s/\&/\&amp;/g;
        $chars =~ s/</\&lt;/g;
        $chars =~ s/>/\&gt;/g;
    }

    return $chars;
}

##################################################################################
#  I'm not sure these are used anymore...
#
#
#
#
#

####
# Sets the input character set, either iso-8859-1 or utf-8
####
sub set_input_charset {
    my ( $self, $charset ) = @_;

    $charset = lc $charset;
    if ( $charset eq 'utf-8' ) {
        $self->{UTF8_INPUT} = 1;
    } elsif ( $charset eq 'iso-8859-1' or $charset eq 'latin-1' ) {
        $self->{UTF8_INPUT} = 0;
    } else {

        # More charsets should probably not be added here.  Anything else
        # should be converted to utf-8 before being used with any xmlwriter.
        die "unsupported charset $charset";
    }
}

####
# Set the input charset, saving the old one on a stack for later
# retrieval.
####
sub push_input_charset {
    my ( $self, $charset ) = @_;
    push @{ $self->{CHARSETSTACK} }, $self->{UTF8_INPUT};
    $self->set_input_charset($charset);
}

sub pop_input_charset {
    my ($self) = @_;
    $self->{UTF8_INPUT} = pop @{ $self->{CHARSETSTACK} };
}

###
1;    # Play nicely.
###