#!/usr/bin/env perl
#-*- Mode: perl; tab-width: 2; indent-tabs-mode: nil; c-basic-offset: 2 -*-

# XML printing, scanning and parsing.
#
# Copyright (C) 2000-2001 Ximian, Inc.
#
# Authors: Hans Petter Jansson <hpj@ximian.com>
#          Arturo Espinosa <arturo@ximian.com>
#          Kenneth Christiansen <kenneth@gnu.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU Library General Public License as published
# by the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.


require "___scriptsdir___/util.pl";
require "___scriptsdir___/general.pl";
require "___scriptsdir___/debug.pl";


# --- XML print formatting  --- #


# &xst_xml_enter: Call after entering a block. Increases indent level.
# &xst_xml_leave: Call before leaving a block. Decreases indent level.
# &xst_xml_print_indent: Call before printing a line. Indents to current level. 
# &xst_xml_print_vspace: Ensures there is a vertical space of one and only one line.
# &xst_xml_print: Indent, then print all arguments. Just for sugar.


my $xst_indent_level = 0;
my $xst_have_vspace = 0;

my @xst_xml_stack;

sub xst_xml_print_begin
{
  my ($name) = @_;

  $name = $xst_name if !$name;
  
  &xst_xml_print_string ("<?xml version='1.0' encoding='ISO-8859-1' standalone='yes'?>\n");
  &xst_xml_print_string ("<!DOCTYPE $name []>\n\n");
  &xst_xml_print_string ("<$name>\n");

  &xst_xml_enter ();

  &xst_xml_print_vspace ();
  &xst_xml_print_line ("<!-- Configuration starts here -->\n");
  &xst_xml_print_vspace ();
}


sub xst_xml_print_request_end
{
  &xst_xml_print_string ("<!-- XST: end of request -->\n");
}


sub xst_xml_print_end
{
  my ($name) = @_;

  $name = $xst_name if !$name;
  
  &xst_xml_print_vspace ();
  &xst_xml_print_line ("<!-- End of configuration -->\n");
  &xst_xml_print_vspace ();

  &xst_xml_leave ();

  &xst_xml_print_string ("</$name>\n");
}


sub xst_xml_enter
{
  $xst_indent_level += 2;
}


sub xst_xml_leave
{
  $xst_indent_level -= 2;
}


sub xst_xml_print_string
{
  print $_[0];
  &xst_debug_print_string_to_file ("out.xml", $_[0]);
}

sub xst_xml_format_indent
{
  $xst_have_vspace = 0;
  return " " x $xst_indent_level;
}

sub xst_xml_print_indent
{
  &xst_xml_print_string(&xst_xml_format_indent ());
}

sub xst_xml_print_vspace
{
  if (not $xst_have_vspace)
  {
    &xst_xml_print_string ("\n");
    $xst_have_vspace = 1;
  }
}


sub xst_xml_print_line
{
  my $line;
  $line = join ("", @_);
  $line =~ tr/\n//d;

  &xst_xml_print_indent ();
  &xst_xml_print_string ($line . "\n");
}

sub xst_xml_format_pcdata # (name, pcdata)
{
  my ($name, $pcdata) = @_;
  
  if ($pcdata) {
    return "<$name>$pcdata</$name>";
#    xst_xml_print_line ("<$name>$pcdata</$name>");
  }
}

sub xst_xml_print_pcdata # (name, pcdata)
{
  my ($name, $pcdata) = @_;
  my $line = xst_xml_format_pcdata ($name, $pcdata);

  &xst_xml_print_line ($line); 
}

sub xst_xml_format_state_tag
{
  my ($name, $state) = @_;
  my $boolean = xst_print_boolean_truefalse ($state);

  return "<$name state='$boolean'/>";
}

sub xst_xml_print_state_tag
{
  my ($name, $state) = @_;
  my $state_tag = xst_xml_format_state_tag ($name, $state);

  &xst_xml_print_line ($state_tag); 
}

# Pass a hash and the keys whose items are scalars. Print <key>val</key>.
sub xst_xml_print_scalars
{
  my ($h, @scalar_keys) = @_;
  my ($i, $val);

  @scalar_keys = sort @scalar_keys;

  while ($i = shift @scalar_keys)
  {
    $val = &xst_xml_quote ($$h{$i});
    &xst_xml_print_line ("<$i>$val</$i>\n") if exists $$h{$i};
  }
}

# Pass a hash and the keys whose items are arrays. Print <key>val</key> foreach val
# in the array at hash{key}
sub xst_xml_print_arrays
{
  my ($h, @array_keys) = @_;
  my ($i, $j, $val);
  
  foreach $i (sort @array_keys)
  {
    if (exists $$h{$i})
    {
      &xst_xml_print_vspace ();
      foreach $j (@{$$h{$i}})
      {
        $val = &xst_xml_quote ($j);
        &xst_xml_print_line ("<$i>$val</$i>\n");
      }
    }
  }
}

# Pass a hash, create a parent tag $tag and print <key>val</key> for every
# value pair in the hash.
sub xst_xml_print_hash
{
  my ($hash, $tag) = @_;
  my ($j, $val);
  
  &xst_xml_print_vspace ();
  &xst_xml_print_line ("<$tag>\n");
  &xst_xml_enter ();
  
  foreach $j (sort keys (%$hash))
  {
    $val = &xst_xml_quote ($$hash{$j});
    &xst_xml_print_line ("<$j>$val</$j>\n");
  }
  
  &xst_xml_leave ();
  &xst_xml_print_line ("</$tag>\n");
}

sub xst_xml_print_hash_hash
{
  my ($h, $tag) = @_;
  my $i;
  
  foreach $i (sort keys %$h)
  {
    &xst_xml_print_hash ($$h{$i}, $tag);
  } 
}

sub xst_xml_container_enter # (name)
{
  my ($container) = @_;

  ## xst_xml_stack is not my, as it is defined at top,
  ## so it is global
  push @xst_xml_stack, $container;

  &xst_xml_print_line ("<$container>");
  &xst_xml_enter();
}

sub xst_xml_container_leave
{
  ## checks if there is a start tag
  if ($#xst_xml_stack >= 0)
  { 
    my $current_container = pop @xst_xml_stack;

    &xst_xml_leave ();
    &xst_xml_print_line ("</$current_container>");
  }
}

sub xst_xml_print_container # (name, @strings)
{
  my ($name, @strings) = @_;

  if (@strings) {
    &xst_xml_container_enter ($name);
    foreach $tag (@strings) {
      &xst_xml_print_line ("$tag");
    }
    &xst_xml_container_leave ();
  }
} 

# --- XML scanning --- #


# This code tries to replace XML::Parser scanning from stdin in tree mode.

sub xst_xml_scan_make_kid_array
{
  my %hash = {};
  my @sublist;

  @attr = $_[0] =~ /[^\t\n\r ]+[\t\n\r ]*([a-zA-Z0-9_-]+)[ \t\n\r]*\=[ \t\n\r\"\']*([a-zA-Z0-9_-]+)/g;
  %hash = @attr;

  push (@sublist, \%hash);
  return \@sublist;
}


sub xst_xml_scan_recurse
{
  my @list;
  if (@_) { @list = $_[0]->[0]; }
  
  while (@xst_xml_scan_list)
  {
    $el = $xst_xml_scan_list[0]; shift @xst_xml_scan_list;

    if (($el eq "") || $el =~ /^\<[!?].*\>$/s) { next; }  # Empty strings, PI and DTD must go.
    if ($el =~ /^\<.*\/\>$/s)  # Empty.
    {
      $el =~ /^\<([a-zA-Z0-9_-]+).*\/\>$/s;
      push (@list, $1);
      push (@list, &xst_xml_scan_make_kid_array ($el));
    }
    elsif ($el =~ /^\<\/.*\>$/s)  # End.
    {
      last;
    }
    elsif ($el =~ /^\<.*\>$/s)  # Start.
    {
      $el =~ /^\<([a-zA-Z0-9_-]+).*\>$/s;
      push (@list, $1);
      $sublist = &xst_xml_scan_make_kid_array ($el);
      push (@list, &xst_xml_scan_recurse ($sublist));
      next;
    }
    elsif ($el ne "")  # PCDATA.
    {
      push (@list, 0);
      push (@list, "$el");
    }
  }

  return \@list;
}


sub xst_xml_read_file
{
  my ($file) = @_;
  my ($doc, $i);
  local *INPUT_FILE;
  
  open INPUT_FILE, $file;
  $doc .= $i while ($i = <INPUT_FILE>);
  close INPUT_FILE;

  return $doc;
}


sub xst_xml_read_stdin
{
  my ($i, $doc);
  
  while (! $i =~ /^<!-- XST: end of request -->$/)
  {
    $doc .= $i;
    $i = <STDIN>;
  }

  return $doc;
}


sub xst_xml_scan  # (file) If no file specified, reads stdin.
{
  my ($file) = @_;
  my ($doc, @tree);

  $file = $xst_input_file if $file eq undef;

  if ($file)
  {
    $doc = &xst_xml_read_file ($file);
  }
  else
  {
    $doc = &xst_xml_read_stdin ();
  }

  &xst_debug_print_log_to_file ("in.xml", $doc);

  @xst_xml_scan_list = ($doc =~ /([^\<]*)(\<[^\>]*\>)[ \t\n\r]*/mg); # pcdata, tag, pcdata, tag, ...
  $tree = &xst_xml_scan_recurse;
    
  return $tree;
}


@xst_xml_entities = ( "&lt;", '<', "&gt;", '>', "&apos;", '\'', "&quot;", '"', "&amp;", '&' );


sub xst_xml_quote
{
  my $in = $_[0];
  my $out = "";
  my @xe;
  my $joined = 0;
  
  my @clist = split (//, $in);
  
  while (@clist)
  {
    # Find character and join its entity equivalent.
    # If none found, simply join the character.
	
    $joined = 0;		# Cumbersome.
    
    for (@xe = @xst_xml_entities; @xe && !$joined; )
    {
      if ($xe [1] eq $clist [0]) { $out = join ('', $out, $xe [0]); $joined = 1; }
      shift @xe; shift @xe;
    }
	
    if (!$joined) { $out = join ('', $out, $clist [0]); }
    shift @clist;
  }
  
  return $out;
}


sub xst_xml_unquote
{
  my $ret = $_[0];
  my $i;

  #print STDERR "INI U: $ret\n";
  
  for ($i = 0; $xst_xml_entities[$i] ne undef; $i += 2)
  {
    $ret =~ s/$xst_xml_entities[$i]/$xst_xml_entities[$i + 1]/g;
  }

  #print STDERR "END U: $ret\n";
  
  return $ret;
}


# --- XML parsing --- #


sub xst_xml_get_pcdata
{
  my $tree = $_[0];
  my $retval;
  
  shift @$tree;  # Skip attributes.
  
  while (@$tree)
  {
    if ($$tree[0] == 0)
    {
      $retval = &xst_xml_unquote ($$tree[1]);
      &xst_debug_print_line ("xst_xml_get_pcdata: $retval");
      return ($retval);
    }
    
    shift @$tree;
    shift @$tree;
  }

  return "";
}

# Compresses node into a word and returns it.

sub xst_xml_get_word
{
  my $tree = $_[0];
  my $retval;

  $retval = &xst_xml_get_pcdata ($tree);
  $retval =~ tr/ \n\r\t\f//d;
  return $retval;
}


# Compresses node into a size and returns it.

sub xst_xml_get_size
{
  my $tree = $_[0];
  my $retval;

  $retval = &xst_xml_get_word ($tree);
  if ($retval =~ /Mb$/)
  {
    $retval =~ tr/ Mb//d; 
    $retval *= 1024;
  }

  return $retval;
}


# Replaces misc. whitespace with spaces and returns text.

sub xst_xml_get_text
{
  my $tree = $_[0];
  my $retval;

  $retval = &xst_xml_get_pcdata ($tree);
  my $type = ref ($retval);

  if (!$type) { $retval =~ tr/\n\r\t\f/    /; }  

  return $retval;
}

sub xst_xml_get_state
{
  my ($tree) = @_;

  # Check attribute; 'yes', 'true', 'no', 'false'.
  return &xst_read_boolean ($$tree[0]->{state});
}

1;