########################################################################## A Simple Parser for automating the specializations crated in FOCUS.## @author Arvind S. Krishna <arvindk@dre.vanderbilt.edu>## $Id: FOCUSParser.pm 68379 2005-09-29 21:34:37Z arvindk $## 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 operationsuse XML::DOM;# Generic file operationsuse FileHandle;# Creating files and renaming themuse File::Copy;# Creating directoriesuse 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;