Subversion Repositories DevTools

Rev

Rev 2026 | Blame | Compare with Previous | Last modification | View Log | RSS feed

#! perl
########################################################################
# Copyright (C) 2006 ERG Limited, All rights reserved
#
# Module name   : jats.sh
# Module type   : Makefile system
# Compiler(s)   : n/a
# Environment(s): jats
#
# Description   : Covert an entire directory of package snadboxes from
#                 one project to another project
#
#                 * Locate all the sandboxes
#                 * In each view do:
#                       * Locate build files
#                       * Determine label and calcularte new label
#                       * Rewrite the build file
#                       * Check the new build file in
#
# Usage:
#
# Version   Who      Date        Description
#
#......................................................................#

require 5.006_001;
use strict;
use warnings;
use Cwd;

use JatsError;
use JatsSystem;
use Pod::Usage;
use Getopt::Long;
use File::Find;


my $VERSION = "1.0.0";                      # Update this
my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
my $opt_help = 0;
my $opt_manual = 0;
my $opt_newproject;
my $opt_oldproject;


#-------------------------------------------------------------------------------
# Function        : Mainline Entry Point
#
# Description     :
#
# Inputs          :
#
my $result = GetOptions (
                "help+"         => \$opt_help,              # flag, multiple use allowed
                "manual"        => \$opt_manual,            # flag, multiple use allowed
                "verbose+"      => \$opt_verbose,           # flag, multiple use allowed
                "newproject=s"  => \$opt_newproject,
                "oldproject=s"  => \$opt_oldproject,
                );

                #
                #   UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!
                #

#
#   Process help and manual options
#
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
pod2usage(-verbose => 1)  if ($opt_help == 2 );
pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));

#
#   Configure the error reporting process now that we have the user options
#
ErrorConfig( 'name'    =>'ConvertRelease',
             'verbose' => $opt_verbose,
             'debug'   => $opt_debug );

Error ("Must specify both old and new project suffixes")
    unless ( $opt_newproject && $opt_oldproject );

#
#   Process all top level directories
#
my $Cwd = getcwd();                          # Current working dir
foreach my $dir ( glob ('*') )
{
    Verbose2("Scanning: $dir" );
    next if ( $dir =~ m/^\./ );
    next unless ( -d $dir  );
    process_dir ( $dir );
    chdir $Cwd || Error ("Cannot CD to original directory");
    Message ("End of processing for: $dir" );
}

exit 0;

#-------------------------------------------------------------------------------
# Function        : process_dir
#
# Description     : Process one directory
#
# Inputs          : $dir                - The name of the directory
#
# Returns         :
#
sub process_dir
{
    my ($dir) = @_;
    Message ("Processing: $dir");

    chdir $dir || Error ("Cannot CD to $dir");

    #
    #   Locate the ONE buildfile within the current directory tree
    #
    my @build_list = locate_build_files( getcwd() );
    if ( $#build_list > 0 )
    {
        foreach my $fe ( @build_list )
        {
            Message( "Build file: $fe->[0] Name: $fe->[1]");
        }
        Error ("Multiple Build Files located" );
    }

    #
    #   CD to the build directory
    #
    my $build_dir = $build_list[0]->[0];
    my $build_file = $build_list[0]->[1];
    Message ("Found Build files: $build_dir");
    chdir ( $build_dir ) || Error("Cannot CD to: $build_dir" );

    #
    #   Determine the label on which the view is based
    #   This will allow us to calculate a 'new' label
    #
    my @elements;
    my $cmd = "cleartool catcs";
    open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
    while (<CMD>)
    {
        #
        #   Filter output from the user
        #
        chomp;
        Verbose2("catcs: $_");
        next unless ( m/element/ );
        next if ( m/-none/ );
        next if ( m/CHECKEDOUT/ );
        my @bits = split ( ' ', $_ );
        Verbose("LABEL: $bits[2]");
        push @elements, $bits[2];
    }
    close(CMD);

    Error ("No labels found")if ( $#elements < 0 );
    Error ("Multiple labels found")if ( $#elements > 0 );

    #
    #   Calculate NEW label
    #
    my $new_label = $elements[0];
    $new_label =~ s~\.$opt_oldproject$~.$opt_newproject~;
    Message("New label: $new_label");

    #
    #   Rewrite the build file
    #
    JatsTool ("jats_rewrite.pl ",
                    "-old=$opt_oldproject",
                    "-new=$opt_newproject",
                    "-infile=$build_file",
                    "-outfile=xxxxxx.pl" );

}

#-------------------------------------------------------------------------------
# Function        : locate_build_files
#
# Description     : Locate all potential buildfiles in the view
#
# Inputs          : base_dir     - Start directory
#
# Returns         : An array of build files
#                   Each entry in the array conatins
#                       Directory
#                       Filename
#
my @located_files;
my $locate_files_base;
sub locate_build_files
{
    my ( $base_dir) = @_;

    #
    #   Locate build files ( JATS and ANT )
    #
    sub locate_build_files_wanted
    {

        my $dir = "$File::Find::dir";
        my $file = $_;
        my $arg = "$dir/$file";

        return if ( -d $arg );
#        print "$arg\n";

        #
        #   Detect a JATS build file
        #
        if ( $file eq "build.pl"  )
        {
            push @located_files, [ $dir, $file ];
            return;
        }

        #
        #   Detect ANT {packagename}depends.xml file
        #
        if ( $file =~ m/(.+)depends.xml$/ )
        {
            if ( -f $1 . ".xml" )
            {
                push @located_files, [ $dir, $file ];
                return;
            }
        }
    }

    @located_files = ();
    $locate_files_base = $base_dir;
    File::Find::find ( \&locate_build_files_wanted, $base_dir );
    return @located_files;
}