# Copyright 1999-2012. Parallels IP Holdings GmbH. All Rights Reserved.
package XmlNode;

#
# Mixed mode is not supported
#
# ::new($name)
#
# ->setAttribute($name, $value[, $encoding])
# ->setText($text)
# ->addChild($child)
#
# ->serialize(*FH[, $prettyPrint[, $omitXmlDeclaration]])
#
use strict;

use Encoding;
use Logging;

my $startSavePath = '';
my $nocompatibilityProcs;

sub new {
  my $self = {};
  bless( $self, shift );
  $self->_init(@_);
  return $self;
}

sub setStartSavePath{
  my ( $path ) = @_;
  $startSavePath = $path;
}

sub resetCompatibilityProcs{
  $nocompatibilityProcs = 1;
}

sub ReleaseCode {
  my $self = shift;
  undef $self->{'ATTRIBUTE'};
  undef $self->{'CONTENT'};
  undef $self->{'ADDCHILD'};
  undef $self->{'PRINT_TREE'};
  undef $self->{'PRINT'};

  my $child;
  foreach $child ( @{ $self->{children} } ) {
    $child->ReleaseCode();
  }
}

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

  if (exists $args{raw}) {
    $self->{raw} = $args{raw};
    return;
  }

  $self->{name}       = $name;
  $self->{attributes} = {};
  $self->{children}   = [];
  $self->{text}       = undef;
  $self->{metadata}   = undef;

  die "Could not create XmlNode instance without name specified" if (!$name);

  my ( $option, $value );
  while ( ( $option, $value ) = each %args ) {
    if ( $option eq "content" ) {
      if ( defined $value ) {
        $self->setText($value);
      }
    }
    elsif ( $option eq "attributes" ) {
      my %attributes = %{$value};
      my ( $attrname, $attrvalue );
      while ( ( $attrname, $attrvalue ) = each %attributes ) {
        $self->setAttribute( $attrname, $attrvalue );
      }
    }
    elsif ( $option eq "children" ) {
      $self->addChild($_) foreach @{$value};
    }
    else {
      die "Unknown option passed to XmlNode: $option";
    }
  }

  #COMPATIBILITY
  if( not $nocompatibilityProcs ){
    $self->{'ATTRIBUTE'} = sub { return $self->setAttribute(@_); };
    $self->{'CONTENT'} =
      sub { (@_) ? return $self->setText(@_) : return $self->getText(); };
    $self->{'ADDCHILD'}   = sub { return $self->addChild(@_); };
    $self->{'PRINT_TREE'} = sub { if( scalar(@_)==2 ) { return $self->serializeChild( $_[0], $_[1] ); } else { return $self->serialize( $_[0] ); } };
    $self->{'PRINT'}      = sub { return $self->serialize( $_[0], 0, 1 ) };
  }
}

sub getName {
  my ($self) = @_;
  return $self->{name};
}

sub setAttribute {
  my ( $self, $name, $value, $encoding, $doNotEscape ) = @_;
  die "'undef' name passed to XmlNode::setAttribute" if !$name;
  die "'undef' value passed to XmlNode::setAttribute for '$name'" if !defined $value;

  $value = ($doNotEscape)
    ? Encoding::encode( $value, $encoding )
    : _xmlAttributeEscape( Encoding::encode( $value, $encoding ) );
  $self->{attributes}->{$name} = $value;
}

sub getAttribute {
  my ( $self, $name ) = @_;
  die "'undef' name passed to XmlNode::getAttribute" if !$name;

  return $self->{attributes}->{$name};
}

sub getAttributes {
  my ( $self ) = @_;

  my %ret;

  foreach my $attr ( keys %{$self->{attributes}} ) {
    $ret{$attr} = $self->getAttribute($attr);
  }

  return %ret;  
}

sub isAttributeExist {
  my ( $self, $name ) = @_;  
  return exists $self->{attributes}->{$name};
}

sub setText {
  my ( $self, $text ) = @_;
  $self->{text} = _xmlTextEscape( Encoding::encode($text) );
  $self->_sanityCheck();
}

sub setTextAsIs {
  my ( $self, $text ) = @_;
  $self->{text} = $text;
  $self->_sanityCheck();
}

sub getText {
  my ($self) = @_;
  return $self->{text};
}

sub setMetadata {
  my ( $self, $metadata ) = @_;
  $self->{metadata} = $metadata;
}

sub getMetadata {
  my ($self) = @_;
  return $self->{metadata};
}

sub addChild {
  my ( $self, $childNode, $position ) = @_;
  if ( ref($childNode) =~ /XmlNode/ ) {
    
    if( $position ){
      unshift @{ $self->{children} }, $childNode;
    }
    else{
      push @{ $self->{children} }, $childNode;
    }
    $self->_sanityCheck();
  }
}

sub getChildren {
  my ( $self, $childName ) = @_;

  my @ret;

  if ( $childName ) {
    foreach my $childNode (@{$self->{children}}) {
      push @ret, $childNode if ($childNode->{name} eq $childName);
    }
  }
  else {
    foreach my $childNode (@{$self->{children}}) {
      push @ret, $childNode;
    }
  }

  return @ret;
}

sub getChild {
  my ( $self, $childName, $create, $position ) = @_;

  my $ret;
  foreach my $child (@{$self->{children}}) {
    if( $child and $child->{name} eq $childName) {
	    die "The element '$self->{name}' has multiply elements '$childName', expected one!" if $ret;
	    $ret = $child;
    }
  }
  if( not $ret and $create ){
    $ret = XmlNode->new( $childName );
    $self->addChild( $ret, $position );
  }
  return $ret;
}

sub removeChildren {
  my ( $self, $childName ) = @_;

  if ( $childName ) {
    my @children = grep { $_->{name} ne $childName } @{$self->{children}};
    $self->{children} = \@children;
  }
  else {
    $self->{children} = [];
  }
}

sub getChildAttribute {
  my ( $self, $childName, $attributeName ) = @_;
  my $ret;
  my $child = $self->getChild( $childName );
  if( defined $child ) {
    $ret = $child->getAttribute( $attributeName );
  }
  return $ret;
}


sub copy {
  my ( $self, $noChildren ) = @_;
  
  my $newNode = XmlNode->new( $self->getName() );
  foreach my $attr ( keys %{$self->{attributes}} ) {
    $newNode->setAttribute( $attr, $self->getAttribute($attr) );
  }

  $newNode->setText($self->{text}) if ( defined $self->{text} );

  $newNode->setMetadata($self->{metadata}) if ( defined $self->{metadata} );

  unless ( defined $noChildren ) {
    foreach my $childNode (@{$self->{children}}) {
      $newNode->addChild( $childNode->copy($noChildren) );
    }
  }
  
  return $newNode
}

sub _FileHandleSerializer {
  my $fh = shift;
  return sub { 
    my ($data) = @_;
    print $fh $data;
  };
}

sub _StringSerializer {
  my $str = shift;
  return sub { 
    my ($data) = @_;
    $$str .= $data;
  };
}

sub serialize {
  my ( $self, $fh, $prettyPrint, $omitXmlDeclaration ) = @_;

  my $out2Str;
  my $strOut;
  my $serialize;
  if ( defined $fh ) {
    $serialize = XmlNode::_FileHandleSerializer($fh);
  }
  else {
    $serialize = XmlNode::_StringSerializer(\$strOut);
    $out2Str = 1;
  }
  
  if ( !$omitXmlDeclaration ) {
    &$serialize('<?xml version="1.0" encoding="UTF-8"?>');
    &$serialize("\n");
  }

  $self->_serializeNode( $serialize, 1, $prettyPrint );
  if ( $out2Str ) {
    return $strOut;
  }
}

sub serializeChild {
  my ( $self, $fh, $child ) = @_;

  my $serialize = XmlNode::_FileHandleSerializer($fh);

  &$serialize( '<?xml version="1.0" encoding="UTF-8"?>' );
  &$serialize( "\n" );

  &$serialize( $self->_serializeTag( 1, 0 ) );
  my $dumpInfo = $self->getChild( 'dump-info' );
  $dumpInfo->_serializeNode( $serialize, 1, 1, ) if $dumpInfo;
  $child->_serializeNode( $serialize, 1, 1, );
  &$serialize( $self->_serializeTag( 0, 1 ) );
}

sub _serializeNode {
  my ( $self, $serialize, $indent, $prettyPrint ) = @_;

  &$serialize( "  " x $indent);

  if ( defined $self->{raw} ) {
    &$serialize($self->{raw});
    return;
  }

  if ( !@{ $self->{children} } && !defined $self->{text} ) {
    &$serialize( $self->_serializeTag( 1, 1 ) );
    return;
  }

  &$serialize( $self->_serializeTag( 1, 0 ) );

  my $child;
  foreach $child ( @{ $self->{children} } ) {
    $child->_serializeNode( $serialize, $indent + 1, $prettyPrint ) if defined $child;
  }
  &$serialize( ( defined $self->{text} ) ? $self->_trimInvalidChars($self->{text}) : "  " x $indent );

  &$serialize( $self->_serializeTag( 0, 1 ) );
}

sub _serializeTag {
  my ( $self, $start, $stop ) = @_;

  my $out;
  if ($start) {
    $out = "<" . $self->{name};
    my ( $key, $value );
    while ( ( $key, $value ) = each( %{ $self->{attributes} } ) ) {
      if( $startSavePath and $self->{name} eq 'cid' and $key eq 'path' ){
        $value = substr( $value, length($startSavePath)+1 ) if index( $value, $startSavePath )==0;
      }
      $out .= " $key=\"$value\"";
    }
    if ($stop) {
      $out .= "/>\n";
    }
    else {
      $out .= ( defined $self->{text} ) ? ">" : ">\n";
    }
  }
  else {
    $out = "</" . $self->{name} . ">\n";
  }
  return $out;
}

sub _sanityCheck {
  my ($self) = @_;
  if ( defined $self->{text} and @{ $self->{children} } ) {
    die "Both text and children nodes specified for <$self->{name}/>";
  }
}

# For all non-wrapped with CDATA text node values erase all not allowed characters in XML 1.0
# http://en.wikipedia.org/wiki/Valid_characters_in_XML
sub _trimInvalidChars {
  my ($self, $text) = @_;
  my $invalidCharsPattern = '[^\x09\x0A\x0D\x20-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}]';
  if ($text !~ /^\<\!\[CDATA\[/ && $text =~ /$invalidCharsPattern/) {
    Logging::debug("The following text contain invalid XML characters which will be trimmed: $text");
    $text =~ s/$invalidCharsPattern//go;
    Logging::debug("-> Replaced as: $text");
  }
  return $text;
}

# -- utilities --

sub _xmlTextEscape {
  my ($text) = @_;
  if ( $text =~ /[&<'"]/s ) {
    $text =~ s/&/&amp;/sg;
    $text =~ s/</&lt;/sg;
    $text =~ s/\'/&#39;/sg;
    $text =~ s/\"/&quot;/sg;
  }
  return $text;
}

# Normalization according to the XML 1.0 (Third Edition),
# clauses 2.3 "Common Syntactic Constructs"
# and 3.3.3 "Attribute-value normalization"

sub _xmlAttributeEscape {
  my ($text) = @_;

  if ( $text =~ /[&\r\n\t<"']/s ) {
    $text =~ s/\&/&amp;/sg;
    $text =~ s/\r/&#xD;/sg;
    $text =~ s/\n/&#xA;/sg;
    $text =~ s/\t/&#x9;/sg;
    $text =~ s/\</&lt;/sg;
    $text =~ s/\"/&quot;/sg;
    $text =~ s/\'/&#39;/sg;
  }
  return $text;
}

1;

# Local Variables:
# mode: cperl
# cperl-indent-level: 2
# indent-tabs-mode: nil
# tab-width: 4
# End: