#-- qar_xml_io.pm ----------------------------------------------------------
#
# (c) Copyright Programming Research 2002
#
# Written: C. Waddingham, 29-6-02
#
# Purpose: Provides low level routines for handling xml files. 
#
#---------------------------------------------------------------------------

#-- package QAR_XML_IO: ----------------------------------------------------

package QAR_XML_IO;

use strict;

BEGIN
{
   require QAR_UTIL;

   # @xml_tokens contains the tokenised xml file / xml_buffer.
   #
   our @xml_tokens;

   # $token_cursor is the current location in the @xml_tokens.
   #
   our $token_cursor;
}

#---------------------------------------------------------------------------

sub OPEN_XML_BUFFER
{
   # Usage: OPEN_XML_BUFFER( $xml_file_path );
   #
   # Loads the xml file into memory.
   # Removes the QAR_XML_IO DTD part from the memory image.
   # Lexically parses the memory image for QAR_XML_IO markup and data tokens.
   # Parses the token set for all components of the definition
   # - assumes that $xml_file_path is a well-formed and valid.
   #
   my $xml_file_name = shift;

   my $xml_text = LOAD_FILE_AS_STRING( $xml_file_name );

   # Remove the QAR_XML_IO DTD part from the memory image
   #
   my $xml_data_part = STRIP_XML_DTD( $xml_text );

   @QAR_XML_IO::xml_tokens   = SPLIT_MARKUP_TEXT( $xml_data_part );
   $QAR_XML_IO::token_cursor = 0;
}
   
#---------------------------------------------------------------------------

sub CLOSE_XML_BUFFER
{
   # Usage: CLOSE_XML_BUFFER();
   #
   @QAR_XML_IO::xml_tokens   = ();
   $QAR_XML_IO::token_cursor = undef;
}
    
#---------------------------------------------------------------------------

sub ADVANCE_CURSOR
{
   # Usage: ADVANCE_CURSOR();
   #
   ++$QAR_XML_IO::token_cursor;
}

#---------------------------------------------------------------------------

sub GET_CURRENT_TOKEN
{
   # Usage: $token = GET_CURRENT_TOKEN();
   #
   return $QAR_XML_IO::xml_tokens[ $QAR_XML_IO::token_cursor ];
}

#---------------------------------------------------------------------------

sub BEYOND_LAST_TOKEN
{
   # Usage: $bool = BEYOND_LAST_TOKEN();
   #
   return ( $QAR_XML_IO::token_cursor > $#QAR_XML_IO::xml_tokens  );
}

#---------------------------------------------------------- PARSE_XML_TAG --

sub PARSE_XML_TAG
{
   # Usage: PARSE_XML_TAG( $tag );
   #
   my $tag = shift;

   $tag =~ s/>$//o;

   if ( GET_CURRENT_TOKEN() !~ /^$tag\b.*/ )
   {
      QAR_UTIL::DIEX( "Expected token $tag, found token " . GET_CURRENT_TOKEN(),
                      $QAR_UTIL::die_program_termination );
   }
   
   ADVANCE_CURSOR();
}

#--------------------------------------------------------- PARSE_XML_ITEM --

sub PARSE_XML_ITEM
{
   # Usage: $item_value = PARSE_XML_ITEM( $tag )
   #
   # Parses an item like:
   # <rule_name>rule name text</rule_name>
   # 
   # and returns "rule name text"
   #
   my $tag = shift;

   my $token = GET_CURRENT_TOKEN();

   if ( $token eq "<$tag/>" )
   {
      ADVANCE_CURSOR();
      return "";
   }

   PARSE_XML_TAG( "<$tag>" );

   my $result = GET_CURRENT_TOKEN();
   ADVANCE_CURSOR();

   # Check for case where xml file contains <tag></tag>
   # i.e. data item is "".
   #
   if ( $result eq "</$tag>" )
   {
      # Here with empty item
      #
      return "";
   }
   else
   {
      # Here with item like <tag> data </tag>
      #
      PARSE_XML_TAG( "</$tag>" );

      return DECODE( $result );
   }
}

#---------------------------------------------------------------------------

sub DECODE
{
   # Usage: $string_without_xml_encode = DECODE( $encoded_string );
   #
   my $encoded_string = shift;

   my $str = $encoded_string;

   $str =~ s/&lt;/</go;
   $str =~ s/&gt;/>/go;
   $str =~ s/&amp;/&/go;

   return $str;
}

#-----------------------------------------------------------------

sub LOAD_FILE_AS_STRING
{
   #
   # Usage $string_image_of_file = LOAD_FILE_AS_STRING( $file_name );
   #
   my $file_name = shift;

   if ( -e $file_name )
   {
      open FILE, "<$file_name";
      my @file_lines = <FILE>;
      close( FILE );

      my $data = "";

      foreach my $line ( @file_lines )
      {
         $line =~ s/[\n\r]+$/\n/o;
         $data .= $line;
      }

      return $data;
   }
   else
   {
      QAR_UTIL::DIEX( "$file_name Not found.", $QAR_UTIL::die_program_termination );
   }
}

#---------------------------------------------------------- STRIP_XML_DTD --

sub STRIP_XML_DTD
{
   # Usage: $xml_data_part = STRIP_XML_DTD( $xml_text );
   #
   my $xml_text = shift;

   my $end_of_dtd = index( $xml_text, "]>" );

   if ( $end_of_dtd != -1 )
   {
      return RIGHT2( $xml_text, $end_of_dtd + length( "]>" ) );
   }
   else
   {
      return $xml_text;
   }
}

#------------------------------------------------------ SPLIT_MARKUP_TEXT --

sub SPLIT_MARKUP_TEXT
{
   # Usage: @tokens = SPLIT_MARKUP_TEXT( $text );
   #
   # Returns a list of tokens in supplied XML $text.  Tokens are markup
   # tokens or data tokens.
   #
   my $text = shift;

   my $markup_start_pos = index( $text, "<", 0 );
   my $token_start_pos  = 0;

   my @list = ();

   MARKUP:
   while ( $markup_start_pos != -1 )
   {
      # Insist that markup must start with ::= '<' ( alpha_char | '!' | '%' | '\' );
      #
      START_MARKUP:
### 8-4-6:     while ( substr( $text, $markup_start_pos, 2 ) eq "<<" )
      while ( substr( $text, $markup_start_pos + 1, 1 ) !~ /[A-Za-z\!\%\/]/o )
      {
         $markup_start_pos = index( $text, "<", $markup_start_pos + 2 );

         last MARKUP if ( $markup_start_pos == -1 );
      }

      my $markup_end_pos = index( $text, ">", $markup_start_pos );

      END_MARKUP:
      while ( substr( $text, $markup_end_pos, 2 ) eq ">>" )
      {
         $markup_end_pos = index( $text, ">", $markup_end_pos + 2 );

         last END_MARKUP if ( $markup_end_pos == -1 );
      }

      if ( $markup_end_pos == -1 )
      {
         QAR_UTIL::TRACE( "Badly formed markup tag. Expected > not found for " .
                          substr( $text, $markup_start_pos ) );
         last MARKUP;
      }
      else
      {
         my $data_token = substr( $text, $token_start_pos,
                                  $markup_start_pos - $token_start_pos  );

         $data_token = TRIM( $data_token );

         if ( $data_token ne "" )
         {
            push @list, $data_token;
         }

         $token_start_pos = $markup_end_pos + 1;

         my $markup = substr( $text, 
                              $markup_start_pos,
                              $markup_end_pos - $markup_start_pos + 1 );
         push @list, $markup;
      }

      $markup_start_pos = index( $text, "<", $markup_end_pos + 1 );
   }

   # Handle trailing data token
   #
   if ( $token_start_pos < length( $text ) )
   {
      push @list, TRIM( substr( $text, $token_start_pos ) );
   }

   return @list;
}

#---------------------------------------------------------------------------

sub TRIM
{
   # Usage: $trimmed = TRIM( $str );
   #
   my $str = shift;

   ( $str = $str ) =~ s/^\s*//o;
   ( $str = $str ) =~ s/\s*$//o;

   return $str;

   ( $str = $str ) =~ s/^\s*(.*?)\s*$/$1/o;

   return $str;
}

#-- eof qar_xml_io.pm ------------------------------------------------------

1
