# 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;

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 ) = @_;

  $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 ) = @_;
  die "'undef' name passed to XmlNode::setAttribute" if !$name;
  die "'undef' value passed to XmlNode::setAttribute for '$name'" if !defined $value;

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

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

  my $ret;
  while ((my $attrName, my $value) = each %{$self->{attributes}}) {
    if ($name eq $attrName) {
      $ret = $value;
    }
  }

  return $ret;
}

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

  my %ret;

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

  return %ret;
  
}

sub setText {
  my ( $self, $text, $encoding ) = @_;
  $self->{text} = _xmlTextEscape( Encoding::encode($text, $encoding) );
  $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 addChildren {
  my ( $self, @children ) = @_;
  foreach my $child (@children) {
    $self->addChild($child);
  }
}

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 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 serialize {
  my ( $self, $fh, $prettyPrint, $omitXmlDeclaration ) = @_;

  my $out2Str;
  my $strOut;
  unless ( defined $fh ) {
    $out2Str = 1;
    open( $fh, '>', \$strOut)
  }
  
  if ( !$omitXmlDeclaration ) {
    print $fh '<?xml version="1.0" encoding="UTF-8"?>';
    print $fh "\n";
  }

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

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

  print $fh '<?xml version="1.0" encoding="UTF-8"?>';
  print $fh "\n";

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

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

  print $fh "  " x $indent;

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

  print $fh $self->_serializeTag( 1, 0 );

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

  print $fh $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}/>";
  }
}

sub getContentSize{
 my ($self) = @_;
 my $size = 0;
 foreach my $child ( @{$self->{children} } ) {
    if( $child ) {
      if( $child->{name} eq 'cid' ){
        if( not exists $child->{attributes}->{'referrer'} ) {
          foreach my $cid( @{$child->{children}} ){
            $size += $cid->{attributes}->{'size'};
          }
        }
      }
      elsif( scalar( @{$child->{children}} ) > 0 ) {
        $size += $child->getContentSize();
      }
    }
 }
 return $size;
}

sub getGuid{
  my ($self) = @_;
  return $self->{attributes}->{'guid'}
}

# -- 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:
