focusparser.pm

最新的版本ACE-5.6.8,刚从外文网上搬下,与大家分享.

#########################################################################
# A Simple Parser for automating the specializations crated in FOCUS.
#
# @author Arvind S. Krishna <[e-mail]>
#
# $Id: FOCUSParser.pm 80826 2008-03-04 14:51:23Z wotte $
#
# This parser, parses the specialization file given as an input argument
# and *individually* visits the tags in a pre-determined order to weave
# in the specializations.
# NOTE: This parser will make N passes over the file, where N equals
# to the number of tags defined in the specialization file. This
# approach is intentional as it servers current needs. Future versions
# may enhance this parser and Visit methods to be more intelligent.
###########################################################################
package FOCUSParser;

# for MY own preferences!
use strict;

# XML related operations
use XML::DOM;

# Generic file operations
use FileHandle;

# Creating files and renaming them
use File::Copy;

# Creating directories
use File::Path;

############################################
# GLOBAL CONSTANTS
###########################################
my $FOCUS_PREPEND_TAG = "\/\/@@ ";

####################################################################
# banner: A function that returns the FOCUS banner transformation
# for just clarity purpose only.
###################################################################
sub FOCUS_banner_start
{
  my $banner_str = "// Code woven by FOCUS:\n";
  return $banner_str;
}

sub FOCUS_banner_end
{
  my $banner_str = "// END Code woven by FOCUS\n";
  return $banner_str;
}

#########################################################################
# Visit_ADD: Visit a add element defined in the transform.
# In particular look for the hook defined: search it in the source file
# and add the data in the <data> tags into the file starting from the
# hook, but not including the hook.
##########################################################################
sub Visit_Add
{
  my ($add, $copy_file_name) = @_;

  # Open the copy and transform it
  open (IN, "+<". $copy_file_name) ||
    die "cannot open file: " . $copy_file_name;

  # To update a file in place, we use the temporary
  # file idiom. Perl says this is the best way to
  # do this!
  my $copy_file_tmp = $copy_file_name . "tmp";
  open (OUT, ">". $copy_file_tmp) ||
    die "cannot open temporary file for modying file:" . $copy_file_name;

  # get the hook element defined in the add element
  my $hook = $add->getElementsByTagName ('hook');

  # ensure length of hook == 1;
  if ($hook->getLength != 1)
  {
    print "Assertion Error: An <add> element can have only \
           one <hook> definition";

    # clean up
    close (IN);
    close (OUT);

    # Diagnostic comment
    print " [failure]... Reverting changes \n";

    unlink ($copy_file_name);
    unlink ($copy_file_name . "tmp");
    exit (1);
  }

  # Check if the hook is present in the file at all
  my $hook_str = $hook->item(0)->getFirstChild->getNodeValue;
  chomp ($hook_str);

  #//@@ For now, due to problem with the hook string
  my $search_str = $hook_str;

  while (<IN>)
  {
    if (/$search_str/)
    {
      # Do not remove the hook! It needs to be present
      print OUT $_;

      # FOCUS banner start
      print OUT FOCUS_banner_start;

      # parse <data> ... </data> elements for this add tag
      my @data_list = $add->getElementsByTagName ('data');
      foreach my $data (@data_list)
      {
	my $data_item = $data->getFirstChild->getNodeValue;
	chomp ($data_item);

	# Insert the item
	print OUT "$data_item \n";
      }

      # FOCUS banner end
      print OUT FOCUS_banner_end;
    }
    else
    {  print OUT $_; }
  }

  # Everything went well!
  close (IN);
  close (OUT);

  # replace in place the old file with the new one
  rename ($copy_file_tmp, $copy_file_name);
}

###########################################################################
# Visit_Remove: Visit a <remove> element defined in the transform.
# In particular look for the hook defined: search it in the source file
# and remove the element's value from the source file being searched.
############################################################################
sub Visit_Remove
{
  my ($remove, $copy_file_name) = @_;

  # obtain the data to be removed
  my $search = $remove->getFirstChild->getNodeValue;
  chomp ($search);

  # Open the copy and transform it
  open (IN, "+<" . $copy_file_name) ||
    die "cannot open file: " . $copy_file_name;

  # Update the file in place
  my $copy_file_name_tmp = $copy_file_name . "tmp";
  open (OUT, ">". $copy_file_name_tmp) ||
    die "cannot open temporary file for modying file:" . $copy_file_name;;

  # Removing something is same as search and replace. Replace with ""
  my $replace = "";

  foreach my $line (<IN>)
  {
    if ($line =~/$search/)
    {
      # We do not print the banner information
      # as we have removed something and
      # print the banner will be redundant!

      # replace <search> with <replace>
      $line =~ s/$search/$replace/;

      print OUT $line;
    }
    else { print OUT $line; }
  }

  # Everything went well!
  close (IN);
  close (OUT);

  # replace in place the old file with the new one
  rename ($copy_file_name_tmp, $copy_file_name);
}

#########################################################################
# Visit_Substitute: Visit a <substitute> element defined in the transform.
# In particular look for the <search> element and replace it with the
# <replace> element.
#########################################################################
sub Visit_Substitute
{
  my ($substitute, $copy_file_name) = @_;

  # Open the copy and transform it
  open (IN, "+<". $copy_file_name) ||
    die "cannot open file: " . $copy_file_name;

  # To update a file in place, we use the temporary
  # file idiom. Perl says this is the best way to
  # do this!
  my $copy_file_name_tmp = $copy_file_name . "tmp";
  open (OUT, ">". $copy_file_name . "tmp") ||
    die "cannot open temporary file for modying file:" . $copy_file_name;;

  # check if the match-line keyword is set or not
  my $match_line = $substitute->getAttribute('match-line');

  # <search> .... </search>
  my $search_list = $substitute->getElementsByTagName ('search');

  # ensure length of search == 1;
  if ($search_list->getLength != 1 ||
      $search_list->getLength == 0)
  {
    print "Assertion Error: A <substitute> element can have only \
          one <search> element";
    close (IN);
    close (OUT);

    # Dianostic comment
    print " [failure] reverting changes \n";

    unlink ($copy_file_name);
    unlink ($copy_file_name_tmp);
    exit (1);
  }

  # <replace> .... </replace>
  my $replace_list = $substitute->getElementsByTagName ('replace');
  if ($replace_list->getLength != 1 ||
      $replace_list->getLength == 0)
  {
    print "Assertion Error: A <substitute> element can have only \
           one <replace> element";
    close (IN);
    close (OUT);
    unlink ($copy_file_name);
    unlink ($copy_file_name_tmp);
    exit (1);
  }

  # <search> and <replace> element values
  my $search = $search_list->item(0)->getFirstChild->getNodeValue;
  my $replace = $replace_list->item(0)->getFirstChild->getNodeValue;

  # remove spaces
  chomp ($search);
  chomp ($replace);

  # Search and replace string in the file
  foreach my $line (<IN>)
  {
    # Check if the match line attribute is set. If so then
    # ignore word boundaries. If not, honor word boundaries.
    my $line_matched = 0;
    if (! $match_line)
    {
      if ($line =~/\b$search\b/)
      {
        $line_matched = 1;
      }
    }
    else
    {
      if ($line =~ /$search/)
      {
        $line_matched = 1;
      }
    }

    # Check if the line matched
    if ($line_matched)
    {
      # FOCUS banner start
      print OUT FOCUS_banner_start;

      # replace <search> with <replace>
      # Caveat: What if <search> occures multiple
      # times in the line? Here is how we handle
      # it
      $line =~ s/$search/$replace/g;

      print OUT $line;

      # FOCUS banner end
      print OUT FOCUS_banner_end;
    }
    else { print OUT $line; }
  }

  # everything went well!
  close (IN);
  close (OUT);

  # replace in place the old file with the new one
  rename ($copy_file_name_tmp, $copy_file_name);
}

#########################################################################
# Visit_Comment: Visit the comment-region hooks defined in the
# source code and comment out all code between start and finish of that
# region
#########################################################################
sub Visit_Comment
{
  my ($comment, $copy_file_name) = @_;

  # check for the comment region tags and
  # comment out the region
  my $start_hook_tag = $comment->getElementsByTagName ('start-hook');
  my $end_hook_tag   = $comment->getElementsByTagName ('end-hook');

  if ($start_hook_tag->getLength != 1 ||
      $end_hook_tag->getLength != 1)
  {
    print "Assertion Error: A <comment> element can have only \
           one pair of <start-hook> and <end-hook> tags";
    unlink ($copy_file_name);
    exit (1);
  }

  my $start = $start_hook_tag->item(0)->getFirstChild->getNodeValue;
  my $end =   $end_hook_tag->item(0)->getFirstChild->getNodeValue;

  # What are we looking for:
  # We need to start from "//" . FOCUS_PREPEND_TAG . $hook
  # i.e. //[[@ <blah blah>
  # This will be the format for both start and end
  # //@@ Problems with the hook string
  my $start_hook = $FOCUS_PREPEND_TAG . $start;
  my $end_hook   = $FOCUS_PREPEND_TAG . $end;

  # Open the copy and transform it
  open (IN, "+<". $copy_file_name) ||
    die "cannot open file: " . $copy_file_name;

  my $copy_file_name_tmp = $copy_file_name . "tmp";
  open (OUT, ">". $copy_file_name_tmp) ||
    die "cannot open temporary file for modying file:" . $copy_file_name;

  my $start_commenting = 0;
  while (<IN>)
  {
    if (! /$start_hook/ &&
        ! /$end_hook/)
    {
      if ($start_commenting)
      { print OUT "// " . $_; }
      else
      { print OUT $_; }
    }
    else
    {
      if (/$start_hook/)
      {
        $start_commenting = 1;
        print OUT $_; # print start hook!
      }
      else
      {
        $start_commenting = 0;