Subversion Repositories DevTools

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

$opt_subdir =~ s~\\~/~g;

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 dynamic 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