Subversion Repositories DevTools

#! 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;

}