<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#########################################################################
# A Simple Parser for automating the specializations crated in FOCUS.
#
# @author Arvind S. Krishna &lt;arvindk@dre.vanderbilt.edu&gt;
#
# $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 &lt;data&gt; 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, "+&lt;". $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, "&gt;". $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-&gt;getElementsByTagName ('hook');

  # ensure length of hook == 1;
  if ($hook-&gt;getLength != 1)
  {
    print "Assertion Error: An &lt;add&gt; element can have only \
           one &lt;hook&gt; 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-&gt;item(0)-&gt;getFirstChild-&gt;getNodeValue;
  chomp ($hook_str);

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

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

      # FOCUS banner start
      print OUT FOCUS_banner_start;

      # parse &lt;data&gt; ... &lt;/data&gt; elements for this add tag
      my @data_list = $add-&gt;getElementsByTagName ('data');
      foreach my $data (@data_list)
      {
	my $data_item = $data-&gt;getFirstChild-&gt;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 &lt;remove&gt; 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-&gt;getFirstChild-&gt;getNodeValue;
  chomp ($search);

  # Open the copy and transform it
  open (IN, "+&lt;" . $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, "&gt;". $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 (&lt;IN&gt;)
  {
    if ($line =~/$search/)
    {
      # We do not print the banner information
      # as we have removed something and
      # print the banner will be redundant!

      # replace &lt;search&gt; with &lt;replace&gt;
      $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 &lt;substitute&gt; element defined in the transform.
# In particular look for the &lt;search&gt; element and replace it with the
# &lt;replace&gt; element.
#########################################################################
sub Visit_Substitute
{
  my ($substitute, $copy_file_name) = @_;

  # Open the copy and transform it
  open (IN, "+&lt;". $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, "&gt;". $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-&gt;getAttribute('match-line');

  # &lt;search&gt; .... &lt;/search&gt;
  my $search_list = $substitute-&gt;getElementsByTagName ('search');

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

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

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

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

  # &lt;search&gt; and &lt;replace&gt; element values
  my $search = $search_list-&gt;item(0)-&gt;getFirstChild-&gt;getNodeValue;
  my $replace = $replace_list-&gt;item(0)-&gt;getFirstChild-&gt;getNodeValue;

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

  # Search and replace string in the file
  foreach my $line (&lt;IN&gt;)
  {
    # 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 &lt;search&gt; with &lt;replace&gt;
      # Caveat: What if &lt;search&gt; 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-&gt;getElementsByTagName ('start-hook');
  my $end_hook_tag   = $comment-&gt;getElementsByTagName ('end-hook');

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

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

  # What are we looking for:
  # We need to start from "//" . FOCUS_PREPEND_TAG . $hook
  # i.e. //[[@ &lt;blah blah&gt;
  # 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, "+&lt;". $copy_file_name) ||
    die "cannot open file: " . $copy_file_name;

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

  my $start_commenting = 0;
  while (&lt;IN&gt;)
  {
    if (! /$start_hook/ &amp;&amp;
        ! /$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;
        print OUT $_; # print end hook!
      }
    }
  }

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

  rename ($copy_file_name_tmp, $copy_file_name);
}

###############################################################
# Visit_Copy: visit the &lt;copy&gt; tags and weave the code into the
# source file. In particular, open the source file specified
# in the file-source tag. Search for the start hook and
# copy until the end hook is reached.
###############################################################
sub Visit_Copy
{
  my ($copy_tag, $copy_file_name, $default_module_name, $prefix_path) = @_;

  # Check if a file name has been specified
  my $dest_file_tag = $copy_tag-&gt;getElementsByTagName ('source');

  if (! $dest_file_tag)
  {
    print "Error: &lt;copy-from-source&gt; does not have the &lt;file&gt; tag..";
    print "aborting \n";
    exit 1;
  }

  if ($dest_file_tag-&gt;getLength != 1)
  {
    print "Assertion Error: A &lt;copy-from-source&gt; element can have only \
           one &lt;source&gt; tag from which to copy elements";
    exit (1);
  }

  my $dest_file_name = $dest_file_tag-&gt;item(0)-&gt;getFirstChild-&gt;getNodeValue;

  #Check if the file exists and one is able to access it
  $dest_file_name = $prefix_path . "/" . $default_module_name . "/" . $dest_file_name;

  open (DEST, "&lt;". $dest_file_name) ||
   die "cannot open $dest_file_name \n Wrong &lt;file&gt; tag within &lt;copy-from-source&gt; exiting" ;

  # check for the start and end tags within the target file where
  # one needs to start copying from
  my $start_tag = $copy_tag-&gt;getElementsByTagName ('copy-hook-start');
  my $end_tag   = $copy_tag-&gt;getElementsByTagName ('copy-hook-end');

  if (! $start_tag || ! $end_tag)
  {
    print "Assertion Error: A &lt;copy&gt; element should have a \
           &lt;copy-hook-start&gt; tag and &lt;copy-hook-end&gt; tag \n";
    exit (1);
  }

  # Get the &lt;dest-hook&gt; tag that indicates the destination where the
  # code between the start and end tags will be placed.
  my $dest_hook_tag   = $copy_tag-&gt;getElementsByTagName ('dest-hook');
  if (! $dest_hook_tag)
  {
    print "Assertion Error: &lt;copy-from-source&gt; should have a &lt;dest-hook&gt; \
           tag that dictates where in the source file the code should be \
           placed. \n";
    exit (1);
  }

  # Remove any starting and trailing white spaces
  chomp ($dest_hook_tag);

  # We have everything we need! Do the copy
  my $start_tag_name = $start_tag-&gt;item(0)-&gt;getFirstChild-&gt;getNodeValue;
  my $end_tag_name   = $end_tag-&gt;item(0)-&gt;getFirstChild-&gt;getNodeValue;
  my $dest_tag_name  = $dest_hook_tag-&gt;item(0)-&gt;getFirstChild-&gt;getNodeValue;

  # First we add the FOCUS prepend tags
  $start_tag_name = $FOCUS_PREPEND_TAG . $start_tag_name;
  $end_tag_name   = $FOCUS_PREPEND_TAG . $end_tag_name;
  $dest_tag_name  = $FOCUS_PREPEND_TAG . $dest_tag_name;

  # Step 1: Iterate over the target file till the
  # dest-hook is found in that file
  my $copy_file_name_tmp = $copy_file_name . "tmp";
  open (OUT, "&gt;". $copy_file_name_tmp) ||
    die "cannot open temporary file for modying file:" . $copy_file_name;
  open (IN, "&lt;" . $copy_file_name) ||
    die "cannot open file $copy_file_name specified in the &lt;file&gt; tag \n";

  my $dest_tag_found = 0; #check if tag matched
  foreach my $line (&lt;IN&gt;)
  {
    if ($line =~ /$dest_tag_name/)
    { $dest_tag_found = 1; print OUT $line; last; }

    print OUT $line;
  }
  close (IN);

  # If we reached the end of file before finding the tag!
  if (! $dest_tag_found)
  {
    print "\n Error: &lt;dest-hook&gt; tag missing in file .. aborting \n";
    close (DEST);
    close (IN);
    close (OUT);
    unlink ($copy_file_name_tmp);
    exit (1);
  }

  # Step 2: Now look in the destination file and look for the hooks
  # where one needs to copy. There could be multiple places where the
  # hook can be present. E.g.
  # .......
  # //@@ COPY_START_HOOK
  # ....
  # ....
  # //@@ COPY_END_HOOK
  # ....
  # ....
  # //@@ COPY_START_HOOK
  # ....
  # ....
  # //@@ COPY_END_HOOK
  # Handle this case

  my $line_matched = 0;
  my $start_copying = 0; # initially do not copy
  foreach my $line (&lt;DEST&gt;)
  {
    # Check if the line matches the start tag
    if ($line =~/$start_tag_name/)
    {
      $line_matched += 1;
      $start_copying = 1;
    }
    else
    {
      # Check if the line matches the end tag
      if ($line =~/$end_tag_name/)
      {
        # check if the start tag matched!
        if (! $line_matched)
        {
          print "Assertion error: &lt;copy-hook-end&gt; tag misplaced with \
                 the &lt;copy-hoook-source&gt; \n";
          close (DEST);
          close (IN);
          close (OUT);
          unlink ($copy_file_name_tmp);
          exit (1);
        }

        # decrement the count for nested tags
        $line_matched -= 1;
        if (! $line_matched )
          { $start_copying = 0; }
      }
      else
      {
        # Print out the line
        if ($start_copying)
          { print OUT $line; }
      }
    }
  }

  # At the end of this loop line_matched should be 0
  if ($line_matched)
  {
    print "Error: in $dest_file_name, number of &lt;copy-hook-source&gt; tags \
           did not match the number of &lt;copy-hook-end&gt; tags. Reverting \
           changes. \n";
    close (DEST);
    close (IN);
    close (OUT);
    unlink ($copy_file_name_tmp);
    exit (1);
  }

  # Step 3: Now copy data after the tag in the original file onto the destination
  # file.
  open (IN, "&lt;" . $copy_file_name) ||
    die "cannot open file $copy_file_name specified in the &lt;file&gt; tag \n";
  $dest_tag_found = 0; #used as a flag
  foreach my $line (&lt;IN&gt;)
  {
    if ($dest_tag_found)
    { print OUT $line; }

    # If the hook is found, then don't write the hook onto OUT
    # as it would have been written earlier
    if (! $dest_tag_found &amp;&amp;
        $line =~ /$dest_tag_name/)
      { $dest_tag_found = 1; }
  }

  # Normal exit path
  close (IN);
  close (OUT);
  close (DEST);

  # Rename the tmp file to the file modified
  rename ($copy_file_name_tmp, $copy_file_name);
}

#################################################################
# commit_files: A procedure to commit all the copy files that
# were specialized back to the orginal files.
#################################################################
sub commit_files
{
  my ($path_name, $output_path_name, @files) = @_;

  # iterate over the file_name_list
  foreach my $file (@files)
  {
    # &lt;file name="...."&gt;
    my $file_name = $file-&gt;getAttribute('name');

    # output_path == input_path then do an in place
    # substitution.
    if ($output_path_name eq $path_name)
    {
      rename ($path_name . "/" . $file_name . "copy",
              $path_name . "/" . $file_name);
    }
    else
    {
      # Check if the path_name exists. The path name
      # corresponds to a directory. So create it if it does
      # not exist.
      if (! -d $output_path_name)
      {
        #@@? Need to revert the *copy files?
        mkpath ($output_path_name, 0, 0744) ||
          die "cannot create $output_path_name: commit files failed! \n";
      }

      # move the specialized file to the output directory
      rename ($path_name . "/" . $file_name . "copy",
              $output_path_name . "/" . $file_name);
    }
  }
}

#### Main ########################################################
# Specialize_Component
# procedure to execute the transformations specified in the
# specialization file
##################################################################
sub Specialize_Components
{
  # Get the command line arguments
  my ($prefix_path, $spl_file, $output_prefix) = @_;

  my $parser = XML::DOM::Parser-&gt;new();
  my $doc = $parser-&gt;parsefile($spl_file);

  # Check if the prefix path ends with a / or not
  # if it does not then manually add the / to it
  my $last = substr ($prefix_path, -1);
  if ($last ne "/")
  { $prefix_path = $prefix_path . "/"; }

  # Entry Point: &lt;transform&gt; element
  foreach my $transform ($doc-&gt;getElementsByTagName('transform'))
  {
    # &lt;module tags&gt;
    foreach my $module ($transform-&gt;getElementsByTagName('module'))
    {
      # Complete path name to the module
      my $module_name = $module-&gt;getAttribute('name');
      my $path_name = $prefix_path . $module_name;

      # &lt;file tags&gt;
      my @files = $module-&gt;getElementsByTagName('file');
      foreach my $file (@files)
      {
	# &lt;file name="...."&gt;
	my $file_name = $file-&gt;getAttribute('name');

	# Rather than modifying the files directly, make a local
	# copy of the files and then transform them and commit
	# if there is a file called foo we make a file foo_copy
	my $file_path_copy = $path_name . "/" . $file_name . "copy";
	my $file_path_name = $path_name . "/" . $file_name;

	copy ($file_path_name, $file_path_copy);

	# Diagnostic comment
	print "Instrumenting $file_name ..........";

        # &lt;comment&gt; ... &lt;/comment&gt;
        my @comment_list = $file-&gt;getElementsByTagName ('comment');
        foreach my $comment (@comment_list)
        { Visit_Comment ($comment, $file_path_copy); }

        # &lt;copy-from-source&gt; ... &lt;/copy-from-source&gt;
        my @copy_from_source_files =
          $file-&gt;getElementsByTagName ('copy-from-source');
        foreach my $copy_from_source (@copy_from_source_files)
        {
          Visit_Copy ($copy_from_source,
                      $file_path_copy,
                      $module_name,
                      $prefix_path);
        }

	# &lt;remove&gt; ... &lt;/remove&gt;
	my @remove_list = $file-&gt;getElementsByTagName ('remove');
        foreach my $remove (@remove_list)
	{ Visit_Remove ($remove, $file_path_copy); }

	# &lt;substitute ... &lt;/substitute&gt;
	my @substitute_list = $file-&gt;getElementsByTagName ('substitute');
	foreach my $substitute (@substitute_list)
	{ Visit_Substitute ($substitute, $file_path_copy); }

	# &lt;add&gt; &lt;hook&gt; ...... &lt;/hook&gt; &lt;add&gt;
	my @add_list = $file-&gt;getElementsByTagName ('add');
	foreach my $add (@add_list)
	{ Visit_Add ($add, $file_path_copy); }

	# Everything went well.. Print success
	print " [done] \n";
      }
    }

    # At this point all the specializations in all the modules have
    # succeeded. It is at this point that we need to commit the
    # specializations in each of the modules. That is move the temporary
    # file that we created to the main file that was specialized.
    # This also means that we need another loop and do the same thing
    # as above....
    # &lt;module tags&gt;
    foreach my $module ($transform-&gt;getElementsByTagName('module'))
    {
      # Complete path name to the module
      my $module_name = $module-&gt;getAttribute('name');
      my $path_name = $prefix_path . $module_name;

      # Output path name: append output_prefix to the
      # current module name. Append "/" to create a
      # directory like /foo/bar/baz/
      my $output_path = $output_prefix . "/" . $module_name;

      # &lt;file tags&gt;
      my @files = $module-&gt;getElementsByTagName('file');

      # commit the files
      commit_files ($path_name, $output_path, @files);
    }
  }
}

####
# Requiured for a module
####
1;
</pre></body></html>