focusparser.pm

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

        print OUT $_; # print end hook!
      }
    }
  }

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

  rename ($copy_file_name_tmp, $copy_file_name);
}

###############################################################
# Visit_Copy: visit the <copy> 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->getElementsByTagName ('source');

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

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

  my $dest_file_name = $dest_file_tag->item(0)->getFirstChild->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, "<". $dest_file_name) ||
   die "cannot open $dest_file_name \n Wrong <file> tag within <copy-from-source> exiting" ;

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

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

  # Get the <dest-hook> tag that indicates the destination where the
  # code between the start and end tags will be placed.
  my $dest_hook_tag   = $copy_tag->getElementsByTagName ('dest-hook');
  if (! $dest_hook_tag)
  {
    print "Assertion Error: <copy-from-source> should have a <dest-hook> \
           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->item(0)->getFirstChild->getNodeValue;
  my $end_tag_name   = $end_tag->item(0)->getFirstChild->getNodeValue;
  my $dest_tag_name  = $dest_hook_tag->item(0)->getFirstChild->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, ">". $copy_file_name_tmp) ||
    die "cannot open temporary file for modying file:" . $copy_file_name;
  open (IN, "<" . $copy_file_name) ||
    die "cannot open file $copy_file_name specified in the <file> tag \n";

  my $dest_tag_found = 0; #check if tag matched
  foreach my $line (<IN>)
  {
    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: <dest-hook> 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 (<DEST>)
  {
    # 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: <copy-hook-end> tag misplaced with \
                 the <copy-hoook-source> \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 <copy-hook-source> tags \
           did not match the number of <copy-hook-end> 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, "<" . $copy_file_name) ||
    die "cannot open file $copy_file_name specified in the <file> tag \n";
  $dest_tag_found = 0; #used as a flag
  foreach my $line (<IN>)
  {
    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 &&
        $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)
  {
    # <file name="....">
    my $file_name = $file->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->new();
  my $doc = $parser->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: <transform> element
  foreach my $transform ($doc->getElementsByTagName('transform'))
  {
    # <module tags>
    foreach my $module ($transform->getElementsByTagName('module'))
    {
      # Complete path name to the module
      my $module_name = $module->getAttribute('name');
      my $path_name = $prefix_path . $module_name;

      # <file tags>
      my @files = $module->getElementsByTagName('file');
      foreach my $file (@files)
      {
	# <file name="....">
	my $file_name = $file->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 ..........";

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

        # <copy-from-source> ... </copy-from-source>
        my @copy_from_source_files =
          $file->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);
        }

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

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

	# <add> <hook> ...... </hook> <add>
	my @add_list = $file->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....
    # <module tags>
    foreach my $module ($transform->getElementsByTagName('module'))
    {
      # Complete path name to the module
      my $module_name = $module->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;

      # <file tags>
      my @files = $module->getElementsByTagName('file');

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

####
# Requiured for a module
####
1;