WebSVN – DevTools – /core_devl/trunk/TOOLS/gen_cots.pl

#! perl
########################################################################
# Copyright ( C ) 2009 ERG Limited, All rights reserved
#
# Module name   : jats.sh
# Module type   : Makefile system
# Compiler(s)   : n/a
# Environment(s): jats
#
# Description   : Create a buildable package based on a COTS package
#                 or other package image.
#
#                 Designed to simplify the process of version controlling
#                 handcrafted packages that have been dropped into dpkg_archive
#
# Usage:        See Embedded documentation below
#               jats gen_cots ...
#
#
#......................................................................#

require 5.006_001;
use Cwd;
use strict;
use warnings;
use JatsError;
use FileUtils;
use File::Basename;
use File::Find;
use File::Copy;
use File::Path;

use Pod::Usage;                             # required for help support
use Getopt::Long;
use Cwd;

#-------------------------------------------------------------------------------
#   Global variables
#
my $VERSION = "1.0.0";                      # Update this
my $GBE_DPKG = $ENV{ GBE_DPKG };
my %subdirs;
my %files;
my $DESTDIR = 'src';           # 'src'
my $last_result;
my @error_list;
my $vob_dir  = '';
my $vob_name = '';
my $src_dir;

#
#   Options
#
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_label;
my $opt_vob;
my $opt_test;
my $opt_keep;
my $opt_subdir;
my $opt_image;
my $opt_clear_case = 1;


#-------------------------------------------------------------------------------
# Function        : Mainline Entry Point
#
# Description     :
#
# Inputs          :
#
my $result = GetOptions (
                "help+"         => \$opt_help,              # flag, multiple use allowed
                "manual"        => \$opt_manual,            # flag
                "verbose+"      => \$opt_verbose,           # flag, multiple use allowed
                "label=s"       => \$opt_label,             # String
                "vob=s"         => \$opt_vob,               # String
                "test"          => \$opt_test,              # Flag
                "keep"          => \$opt_keep,              # Flag
                "subdir=s"      => \$opt_subdir,            # string
                "image=s"       => \$opt_image,             # string
                "clearcase!"    => \$opt_clear_case,        # flag

                );

                #
                #   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));
pod2usage(-verbose => 0, -message => "Version: $VERSION") if ( $#ARGV < 0 );

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

#
#   Init the file uitilites
#
InitFileUtils();
Error ("This utility only runs on WINDOWS, not $::ScmHost") unless ( $::ScmHost eq 'WIN' );
Error ("No DPK_ARCHIVE") unless ( $GBE_DPKG );
Error ("Must specify a target VOB") unless ( $opt_vob || ! $opt_clear_case);
Error ("Need two arguments: package and version") unless ( $#ARGV eq 1 );
Error ("Use -keep when clearcase is not used") unless ( $opt_clear_case || $opt_keep );

#
#   Determine base image
#   Either from dpkg_archive or user image
#
if ( $opt_image )
{
    $src_dir =  AbsPath($opt_image);
    Error("Image directory is not present: $src_dir") unless ( -d $src_dir );
}
else
{
    #
    #   Ensure that the package source in dpkg_archive can be found
    #

    $src_dir = "$GBE_DPKG/$ARGV[0]/$ARGV[1]";
    Message ( "Testing $src_dir" );
    Error ("Package not found: $src_dir" ) unless ( -d $src_dir );
    Message ("Found source package");
}

#
#   Ensure target directory is not present
#
$opt_subdir = $ARGV[0] unless ( $opt_subdir );
my $temp_dir = $ENV{TMP} || $ENV{TEMP};
Error ("Cannot locate TEMP directory") unless ( $temp_dir );
$temp_dir =~ s~\\~/~g;
Error ("TEMPDIR is not a directory" ) unless ( -d $temp_dir );
my $dest_dir = "$temp_dir/gen_cots/$opt_subdir";
Verbose ("Work Dir: $dest_dir");

if ( $opt_clear_case )
{
    #
    #   Validate / locate the target VOB
    #
    locate_vob();

    #
    #   Generate a label, if the user has not already specified one
    #
    $opt_label = "$ARGV[0]_$ARGV[1]"
        unless ( $opt_label );

    #
    #   Ensure that the label is not locked
    #   The user will not be able to move the label if it is already locked
    #
    my $label_exists = 0;
    Verbose ("Check label exists");
    ClearCmd ("describe -short lbtype:$opt_label@/$vob_name" ) unless $opt_test;
    $label_exists = 1 unless( $opt_test || grep ( /Label type not found/, @error_list ));
    Verbose ("Check label: $label_exists");

    if ( $label_exists )
    {
        Verbose ("Check label not locked");
        ClearCmd ("describe -fmt %[locked]p lbtype:$opt_label@/$vob_name" );
        unless ( $last_result && $last_result =~ m~unlocked~ )
        {
            Error("Label is locked: $opt_label");
        }
    }
}

#
#   Transfer source to target and remove generated files
#
if ( -d $dest_dir )
{
    Message ("Delete temp directory from previous operation");
    rmtree( $dest_dir );
}

mkpath ($dest_dir,$opt_verbose);
Error( "Cannot create directory: $dest_dir") unless( -d $dest_dir);

mkpath ($dest_dir,$opt_verbose);
Error( "Cannot create target directory") unless ( -d $dest_dir);

Message ("Transfer package to local directory");
File::Find::find( \&CopyDir, $src_dir );


#
#   Create a build.pl file based on a template
#
Message ("Create build.pl");
open (BUILD, ">", "$dest_dir/build.pl" );
while ( <DATA> )
{
    chomp;
    last if ( /^__ENDBUILD/ );

    #
    #   Substitute values
    #
    s~__PACKAGENAME__~$ARGV[0]~g;
    s~__PACKAGEVERSION__~$ARGV[1]~g;
    if ( m/__BUILDNAME__/ )
    {
        if ( $ARGV[1] =~ m~^\d+\.\d+\.\d+[\s.]+(\w+)$~ )
        {
            print BUILD "BuildName       ( '$ARGV[0]', '$ARGV[1]' );\n";
        }
        elsif ( $ARGV[1] =~ m~^(.*)\.+(\D+)$~ )
        {
            my $ver = $1;
            my $prj = $2;
            print BUILD "BuildName       ( '$ARGV[0]', '$ver', '$prj', '--RelaxedVersion' );\n";
        }
        else
        {
            print BUILD "BuildName       ( '$ARGV[0]', '$ARGV[1]', '--RelaxedVersion' );\n";
            print "Buildname: '$ARGV[0]', '$ARGV[1]'\n";
        }
        
        next;
    }

    print BUILD "$_\n";
}
close (BUILD);

#
#   Create a makefile.pl based on a template
#
Message ("Create src/makefile.pl");
mkdir "$dest_dir/src";
open (MAKE, ">", "$dest_dir/src/makefile.pl" );
while ( <DATA> )
{
    chomp;
    last if ( /^__ENDMAKE/ );

    #
    #   Substitute values
    #
    s~__PACKAGENAME__~$ARGV[0]~g;
    s~__PACKAGEVERSION__~$ARGV[1]~g;
    if ( /__PACKAGEFILE__/ )
    {
        unless ( $DESTDIR )
        {
            foreach my $file ( sort keys %files )
            {

                print MAKE "PackageFile ( '*', '../$file', '--StripDir' );\n";
            }
        } else {
            foreach my $file ( sort keys %files )
            {

                print MAKE "PackageFile ( '*', '$file' );\n";
            }
        }
        foreach my $subdir ( sort keys %subdirs )
        {
            print MAKE "PackageFile ( '*', '--DirTree=$subdir' );\n";
        }
        next;
    }
    print MAKE "$_\n";
}
close (MAKE);


#
#   Determine the target directory within the VOB
#   This is the source directory tree, with the last element removed
#
my $target_path = "";
if ( $opt_subdir =~ m~/~ )
{
    $target_path = $opt_subdir;
    $target_path =~ s~/[^/]*$~~;
    $target_path = "/$target_path";
}

#
#   Transfer the image into the target VOB
#   The clearcase command will adjust the target directory to match the source
#
if ( $opt_clear_case )
{
    Message ("Import to clearcase vob: $opt_vob");
    my $cmd = "clearfsimport.exe -nsetevent -rec -rmname";
       $cmd .= " -preview" if $opt_test;
       $cmd .= " -mklabel $opt_label";
       $cmd .= " -c \"Package snapshot $ARGV[0]_$ARGV[1]\"";
       $cmd .= " $dest_dir $opt_vob$target_path";

    Verbose($cmd);
    @error_list = ();
    open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
    while (<CMD>)
    {
        #
        #   Filter output from the user
        #
        chomp;
        Verbose($_);
        push @error_list, $_ if ( m~Error:~ );
    }
    close(CMD);
    if ( @error_list )
    {
        display_error_list();
        Error("Problem encountered saving package image");
    }

    #
    #   Apply label to all directories upto the root of the VOB
    #   The label will have been applied to the TIP
    #
    Verbose ("Label package path");
    my $lpath = $opt_vob;
    foreach ( split ('/', $target_path) )
    {
        $lpath = $lpath . '/' . $_;
        Verbose ("Label package path: $lpath");
        ClearCmd ("mklabel -replace $opt_label $lpath" ) unless $opt_test;
        Error ("Program Terminated") if ( @error_list );
    }

    #
    #   Lock the label
    #
    Message ("Locking label: $opt_label");
    ClearCmd ("lock lbtype:$opt_label\@/$vob_name" ) unless $opt_test;
    Error ("Program Terminated") if ( @error_list );
}
#
#   Remove the created directory
#
if ( $opt_keep )
{
    Warning ("KEEP temp directory: $dest_dir");
}
else
{
    Message ("Delete temp directory");
    rmtree( $dest_dir );
}

#
#   All done
#
if ( $opt_clear_case )
{
    Message ("\n");
    Message ("Release Manager information");
    Message ("Package path : /$vob_name/$opt_subdir");
    Message ("Label        : $opt_label");

    Warning ("Test Mode: Not changes made to the VOB") if ( $opt_test );
}
exit 0;


#-------------------------------------------------------------------------------
# Function        : CopyDir
#
# Description     : Find callback function used to copy the archive
#
# Inputs          :
#
# Returns         :
#
sub CopyDir
{
    my $item = $File::Find::name;
    my $base = File::Basename::basename($item);

    #
    #   Skip generated files
    #
    return if ( $base =~ m/^descpkg$/ );
    return if ( $base =~ m/^RELEASE_NOTES_/ );
    return if ( $base =~ m/^built\./ );

    #
    #   Don't process directories
    #
    return if ( -d $item );

    #
    #   Calculate target directory
    #
    my $sdl = length ($src_dir);
    my $target = $dest_dir . '/' . $DESTDIR . substr ( $item, $sdl );

    #
    #   Determinate top level package directories
    #
    my $rootdir = substr ( $item, 1 + $sdl );
    $rootdir =~ s~/.*~~;

    if ( $rootdir eq $base )
    {
        $files{$base} = 1;
    } else {
        $subdirs{$rootdir} = 1;
    }

    my $tdir = $target;
    $tdir =~ s~/[^/]+$~~;

#    print "================$item, $base, $tdir, $target, $rootdir\n";

    mkpath ($tdir, 0) unless ( -d $tdir );

    Verbose( "Transfer: $target");
    File::Copy::copy( "$item", "$target") || Error("Copy Fault: $item, $target");
    
}

#-------------------------------------------------------------------------------
# Function        : locate_vob
#
# Description     : Locate the target VOB
#                   This is a bit tricky as it makes a few assumptions
#                       1) That clearcase dynamic views are mounted through the "o" drive
#                          This appears to be a standard(ish) configuration.
#
#                       2) There must be a dynamic view on the machine that does have the
#                          required VOB mounted
#
#                   Note: Assumes that the user is NOT trying to place the package
#                         into a subdir of the VOB.
#
# Inputs          : None
#
# Returns         : Global: $opt_vob
#

sub locate_vob
{
    #
    #   If the user has specified an absolute path then use the users VOB
    #
    $opt_vob =~ tr~\\/~/~s;
    if ( $opt_vob =~ m~[A-Za-z]\:/~ || $opt_vob =~ m~/~ )
    {
        Error ("User VOB does not exist: $opt_vob") unless ( -d $opt_vob );

        $opt_vob =~ m~(.*/)(.*)~;
        $vob_dir = $1;
        $vob_name = $2;
        return;
    }

    #
    #   Scan for a dynamic view
    #
    Message ("Scanning for suitable dynamic view");
    my @search_list = glob ("O:/*");
    my $found_vob;
    foreach my $dir ( @search_list )
    {
        my $test_vob = "$dir/$opt_vob";
        Verbose ("Testing vob: $test_vob" );
        next if ( $dir =~ m~solaris~i );                    # Take the hint
        next if ( $dir =~ '/administration_view$' );        # Known read-only VOB

        if ( -d $test_vob )
        {
            $found_vob = $dir;
            last;
        }
    }
    Error ("Cannot find a suitable view with the $opt_vob VOB mounted") unless ( $found_vob );

    $vob_dir = $found_vob;
    $vob_name = $opt_vob;
    $opt_vob = "$vob_dir/$vob_name";
    Message ("Using VOB: $opt_vob");
}


#-------------------------------------------------------------------------------
# Function        : ClearCmd
#
# Description     : Similar to the system command
#                   Does allow standard output and standard error to be captured
#                   to a log file
#
#                   Used since I was having problems with calling other programs
#                   and control-C. It could hang the terminal session.
#
# Inputs          :
#
# Returns         :
#
sub ClearCmd
{
    my( $cmd ) = @_;
    Verbose2 "cleartool $cmd";

        @error_list = ();
        open(CMD, "cleartool $cmd  2>&1 |")    || Error "can't run command: $!";
        while (<CMD>)
        {
            chomp;
            $last_result = $_;
            Verbose ( "cleartool resp:" . $_);
            push @error_list, $_ if ( m~Error:~ );
        }
        close(CMD);

    Verbose2 "Exit Status: $?";
    return $? / 256;
}



#-------------------------------------------------------------------------------
# Function        : display_error_list
#
# Description     : Display the error list
#                   The exit process will be handled by the caller
#
# Inputs          :
#
# Returns         :
#
sub display_error_list
{
    foreach ( @error_list )
    {
        ReportError ("$_");
    }
}


__DATA__
# Copyright (C) 1998-2009 ERG Limited, All rights reserved
#
# Module name   : build.pl
# Module type   : JATS Build File
# Environment(s): JATS Build System
#
# Description:    build.pl for package __PACKAGENAME__
#.........................................................................#

#..     Build system
#
$MAKELIB_PL     = "$ENV{ GBE_TOOLS }/makelib.pl";
$BUILDLIB_PL    = "$ENV{ GBE_TOOLS }/buildlib.pl";

require         "$BUILDLIB_PL";
require         "$MAKELIB_PL";

#..     Product configuration
#
BuildPlatforms   ( 'GENERIC' );

__BUILDNAME__ BuildName       ( '__PACKAGENAME__', '__PACKAGEVERSION__' );
BuildInterface  ( 'interface' );

#
#   Specify subdirectories to process
#
BuildSubDir    ( 'src' );

#
#   Generate Files
BuildDescpkg   ();
BuildMake      ();
__ENDBUILD
# Copyright (C) 1998-2009 ERG Limited, All rights reserved
#
# Module name   : Makefile.pl
# Module type   : JATS Build File
# Environment(s): JATS Build System
#
# Description:    makefile.pl for package __PACKAGENAME__
#
#.........................................................................#

die "Usage: Makefile.pl rootdir Makelib.pl\n"
    unless( $#ARGV+1 >= 2 );
require "$ARGV[1]";

#
# Build platform definitions ..
#
Platform( '*' );

############################################################################
#   Define the source files
#

#.............................................................................
# Packaging definitions
#
__PACKAGEFILE__ PackageFile ( '*', '--DirTree=jar' );

#..
#
Src         ( '*'   , 'descpkg' );
PackageFile ( '*'   , 'descpkg' );

#.............................................................................
# Finally generate the makefile
#
MakefileGenerate();

#..  Successful termination
1;
__ENDMAKE

#-------------------------------------------------------------------------------
#   Documentation
#

=pod

=head1 NAME

gen_cots - Create a buildable package from dpkg_archive and place it under
version control

=head1 SYNOPSIS

jats gen_cots package version


 Options:
    -help              - brief help message
    -help -help        - Detailed help message
    -man               - Full documentation
    -label=name        - Specify a label for the versions source
    -vob=vvv           - VOB to use, my be a full path. default is COTS
    -subdir=nnn        - Named subdir in VOB
    -test              - Do not perform operations that modify clearcase
    -keep              - Keep the creating dpkg_archive image
    -image=path        - Path to alternate source image
    -[no]clearcase     - ClearCase is not present

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-help -help>

Print a detailed help message with an explanation for each option.

=item B<-man>

Prints the manual page and exits.

=item B<-label=name>

This option specifies an alternate label for the checked in source. The
default label is based on package and version.

=item B<-vob=vvv>

This option specifies the VOB into which the saved package will be placed.

There are two ways that this option may be used.

=over 8

=item 1

Simply name the VOB. (ie: COTS) The script will locate a dynamic view on the
users machine that contains the view. This is done by scanning dynic views in
the "O:" drive.

=item 2

The full path to a VOB, including driver is provided. (ie: z:/COTS). This will
prevent the script from locating the VOB. It will use the named view.

=back

If this option is not provided, then the script will use the COTS vob in the
first dynamic view located on the "O:" drive.

=item B<-subdir=name>

This option specifies the name of a subdirectory in which the package will be created.
The default name it taken from the package name.

=item B<-test>

This option will suppress the clearcase operations.
No files will be checked in and the label will not be locked.

=item B<-keep>

If this option is selected then the program will retain the working directory
that it has created.

=item B<-image=path>

If this option is specified then the package will be created using the
specified source path, otherwise the package will be extracted from dpkg_acrhive.

This option allows a locally created image to be stored as a COTS package
before it is placed in dpkg_archive.

=item B<-[no]clearcase>

This option may be used to supress all clearcase operations. The utility will
simply create a directory tree containing a buildable image.

This option should be used in conjunction with -test, else the results will
be discarded.

=back

=head1 DESCRIPTION

This program will create a version controlled and JATS buildable package from
a dpkg_archive package version.

In doing this the program will:

=over 8

=item   *

Create a temporary directory in the users current directory. This will
be used to contain a copy of the package.

=item   *

Transfer the named package and version into the temp directory. The files will
be transferred in the a 'src' directory within the temp directory.

=item   *

Create JATS build.pl and makefile.pls to support the creation of the
package. The build.pl file will contain the package name and the package
version.

=item   *

Transfer the entire image into the named VOB. The files will be labeled
and the VOB view modified to mimic the temp directory view.


=item   *

Lock the label used to mark the files.

=item   *

Remove the temp work space.

=item   *

Display information to be entered into Release Manager.

=back

=head1 EXAMPLE

jats etool gen_cots -vob=z:/COTS mos_api 5.6.0.cr

This will take the version 5.6.0.cr of the mos_api package from dpkg_acrchive
place it under version control within the COTS vob and add files to allow the
dpkg_archive package to be recreated in an JATS buildable manner.


=cut
Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/gen_cots.pl – Rev 299
