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 thismy $opt_debug = $ENV{'GBE_DEBUG'}; # Allow global debugmy $opt_verbose = $ENV{'GBE_VERBOSE'}; # Allow global verbosemy $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 dirforeach 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;}