######################################################################## # Copyright (C) 2008 ERG Limited, All rights reserved # # Module name : jats_ccrelease.pl # Module type : Makefile system # Compiler(s) : Perl # Environment(s): jats # # Description : A script to build a package from a clearcase element # The script will: # Create a clearcase view # Checkout the files # Locate the build file # Build the packages # Install packages # Remove the view # # The script can do a lot of other things too. # # Defined exit code for automation # 10 - No files in extracted view # Root directory not found # 11 - Label not found # 1 - Everything else # #......................................................................# require 5.008_002; use strict; use warnings; use JatsError; use JatsSystem; use FileUtils; use JatsBuildFiles; use ArrayHashUtils; use Pod::Usage; # required for help support use Getopt::Long; use File::Find; use File::Copy; use File::Path; use Cwd; my $VERSION = "1.6.0"; # Update this # # Options # my $opt_debug = $ENV{'GBE_DEBUG'}; # Allow global debug my $opt_verbose = $ENV{'GBE_VERBOSE'}; # Allow global verbose my $opt_help = 0; # User help level my @opt_spec; # Labels used as a base for the view my $opt_vob; # Hint: which VOB to use my $opt_dpkg = 1; # Transfer built package to dpkg_archive my $opt_copy = 0; # Copy built package to user my $opt_reuse = 0; # Re-user view if it exists my $opt_viewname; # View Name my $opt_extract; # Just create a static view my $opt_extract_files; # Just extract files to user - no view my $opt_delete; # Just delete the view my @opt_build; # build files to use (kludge) my $opt_test; # Test the build process - no copy my $opt_cache; # Cache external packages my $opt_keep = 0; # Keep view if successful my $opt_lock = 0; # Lock label before release my $opt_beta; # Create beta release my $opt_merge; # Merge release my $opt_path; # Path for view spec my $opt_runtests = 1; # Run unit tests after build my $opt_latest_root; # Modify config spec with rule (kludge) my $opt_branch; # Create config spec with branch my $opt_debug_build = 0; # Build Debug Only my $opt_prod_build = 0; # Build ion Only my $opt_config_spec; # User provided config spec my $opt_prefix = 1; # Prefix the view tag with user-name my $opt_tag; # View tag insert (build or export or user) my $opt_devModeStr; # Development mode string - not used # # Globals - Provided by the JATS environment # my $USER = $ENV{'USER'}; my $UNIX = $ENV{'GBE_UNIX'}; my $GBE_SANDBOX = $ENV{'GBE_SANDBOX'}; my $GBE_ABT = $ENV{'GBE_ABT'} || '0'; my $MACHINENAME = $ENV{'GBE_HOSTNAME'}; my $GBE_VIEWBASE = $ENV{'GBE_VIEWBASE'}; # Root of the view # # Globals # my $VIEWDIR_ROOT; # Root of the static view my $VIEWTAG; # The view tag my $VIEWDIR; # Absolute path to the view my $VIEWPATH; # Path relative to clearcase my $user_cwd; my $error = 0; my $label_count = 0; # Number of labels to create the view my @label_not_locked; # List of unlocked labels my @label_locked; # List of labels I locked my @error_list; # ClearCmd detected errors my $load_count; # Loaded files my $UNIX_VOB_PREFIX = '/vobs'; my $VOB_PREFIX = $UNIX ? $UNIX_VOB_PREFIX : ''; my $UNIX_VIEW_PREFIX = '/view/'; # Don't know how to determine this value my $WIN32_VIEW_PREFIX = 'o:/'; # Don't know how to determine this value my $VIEW_PREFIX = $UNIX ? $UNIX_VIEW_PREFIX : $WIN32_VIEW_PREFIX ; my $VOB_SEP = $UNIX ? '/' : '\\'; my $view_prefix = "${USER}_"; # # ROOT_VOBS is a list of VOBS too look in first # If a label is not found in these vobs, then the program will # look in all vobs. This list is a hint to speed up searching # my $ROOT_VOB; my $root_vob_spec; my @ROOT_VOBS = qw( /LMOS /DPG_SWBase /DPG_SWCode /ProjectCD /MASS_Dev_Bus /MASS_Dev_Infra /MOS /MASS_Dataman /MASS_Dev /MASS_Dev_Dataman /COTS /GMPTE2005 /GMPTE2005_obe /MPR /MOS ); #------------------------------------------------------------------------------- # Function : Mainline Entry Point # # Description : # # Inputs : # # # Alter some option defaults if we are creating a view within a sandbox # if ( $GBE_SANDBOX ) { $GBE_VIEWBASE = $GBE_SANDBOX; $opt_prefix = 0; (my $sandbox_name = $GBE_SANDBOX) =~ s~.*/~~ ; $opt_tag = 'sandbox.'. $sandbox_name unless ( $opt_tag ); } # # Parse the user options # my $result = GetOptions ( "help+" => \$opt_help, # flag, multiple use allowed "manual:3" => \$opt_help, # flag "v|verbose:+" => \$opt_verbose, # flag, multiple use allowed "label=s" => \@opt_spec, # Array of build specs "spec=s" => \@opt_spec, # Array of build specs "config=s" => \$opt_config_spec, # String "view=s" => \$opt_viewname, # String "vob=s" => \$opt_vob, # String "dpkg!" => \$opt_dpkg, # [no]flag "copy!" => \$opt_copy, # [no]flag "reuse!" => \$opt_reuse, # [no]flag "extract:+" => \$opt_extract, # flag "extractfiles" => \$opt_extract_files, # flag "delete:+" => \$opt_delete, # flag "build=s" => \@opt_build, # An array of build "test!" => \$opt_test, # [no]flag "cache" => \$opt_cache, # flag "keep!" => \$opt_keep, # [no]flag "lock!" => \$opt_lock, # [no]flag "beta!" => \$opt_beta, # [no]flag "merge" => \$opt_merge, # [no]flag "path=s" => \$opt_path, # string "runtests!" => \$opt_runtests, # [no]flag "latestroot=s" => \$opt_latest_root, # String "branch=s" => \$opt_branch, # String "mkbranch=s" => \$opt_branch, # String "prodOnly" => \$opt_prod_build, # flag "debugOnly" => \$opt_debug_build, # flag "root=s" => \$GBE_VIEWBASE, # string "prefix!" => \$opt_prefix, # flag "tag=s" => \$opt_tag, # string 'devMode=s' => \$opt_devModeStr, # Compatability. Not used ); # # 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_help > 2 ); InitFileUtils(); # # Configure the error reporting process now that we have the user options # ErrorConfig( 'name' => 'CCRELEASE', 'verbose' => $opt_verbose ); # # Validate user options # Use either -label or one command line argument # Error ("Unexpected command line arguments present.","Cannot mix -label and command line label" ) if ( $#opt_spec >= 0 && $#ARGV >= 0); push @opt_spec, @ARGV; if ( $opt_config_spec ) { Error("Cannot use -path with -config") if($opt_path); Error("Cannot use -branch with -config") if($opt_branch); Error("Cannot use -vob with -config") if($opt_vob); Error("Cannot use a label with -config") if( @opt_spec); Error("Config spec file not found: $opt_config_spec") unless ( -f $opt_config_spec ); unless ( $opt_viewname ) { $opt_viewname = StripDirExt($opt_config_spec); $opt_viewname =~ s~[\.:/\\]~_~g; } $opt_vob = ""; # # Convert file in an absolute file name # Will be needed as we change directory # $opt_config_spec = FullPath($opt_config_spec); } unless( @opt_spec || $opt_config_spec ) { Error ("Need a view or a label. -help for options") if ( $opt_delete && ! $opt_viewname ); Error ("Need a label or config_spec. -help for options") unless $opt_delete; } # # Convert label with embedded VCS information into a 'normal' form. # Form: # CC::label # CC::path::label # CC::::label # foreach ( @opt_spec ) { if ( $_ =~ m~^(.+?)::(.*?)(::(.+))?$~ ) { Error ("Label contains invalid Version Control Identifier($1): $_") if ( $1 ne 'CC' ); my $ll = $2; my $path; if ( $3 ) { $path = $2; $ll = $4; if ( $path ) { Error ("Multiple conflicting Embedded source paths", "Path: $opt_path", "VCS Spec: $_" ) if ( $opt_path && $path ne $opt_path ); $opt_path = $path; } } $_ = $ll; } Verbose ("Clean URL: $_"); } # # User has specified both debug and production # Then set both to 0 : ie default # if ( $opt_debug_build + $opt_prod_build > 1 ) { $opt_debug_build = 0; $opt_prod_build = 0; } # # User has requested test mode # - Don't copy # - Don't packgae # if ( $opt_test ) { $opt_dpkg = 0; $opt_copy = 0; } # # Determine the machine type # Verbose ("Machine Type: UNIX=$UNIX"); Error ("Machine Name not determined") unless ( $MACHINENAME ); $user_cwd = getcwd; Error ("USER name not determined" ) unless ( $USER ); # # Ensure that the 'cleartool' program can be located # Verbose ("Locate clearcase utility in users path"); Error ("Cannot locate the 'cleartool' utility in the users PATH") unless ( LocateProgInPath('cleartool', '--All') ); # # Clean up the view root directory # $VIEWDIR_ROOT = Realpath($GBE_VIEWBASE) || $GBE_VIEWBASE; Verbose ("Viewpath: $VIEWDIR_ROOT"); Error ("Cannot locate view root directory: $VIEWDIR_ROOT" ) unless (-d $VIEWDIR_ROOT); # # Remove any user name from the front of the view name # Simplifies the deletion process as the user can provide # the directory name # $view_prefix = "" unless ( $opt_prefix ); # # Setup user specified viewname # Include the user name to ensure that the view name is unique-ish # Keep the name as short as possible as some compilers display a fixed # length filename in error messages and this name is part of the path # # Base the viewname on the view label. This will simplify the creation # of multiple views and reduce the risk of unexpected deletion # $opt_viewname = $opt_spec[0] unless ( defined $opt_viewname ); $opt_viewname =~ s~^$view_prefix~~ if (defined($opt_viewname) && $view_prefix && $opt_delete ); # # Create the view tag # Attempt to make this globally unique # Include USER name, MACHINE name, the view name # Optionally include a user 'tag'. Provided to allow the ABT to maintain # multiple instances of a view. # unless ( $opt_tag ) { $opt_tag = $opt_extract_files ? 'extract' : 'build'; } $VIEWTAG = "${USER}_${MACHINENAME}_${opt_tag}_${opt_viewname}"; # # Create a clearcase view to be used for the view # $VIEWPATH = "$view_prefix$opt_viewname"; $VIEWDIR = "$VIEWDIR_ROOT/$VIEWPATH"; $VIEWDIR =~ tr~\\/~/~s; Verbose( "Hostname: $MACHINENAME" ); Verbose( "Viewtag: $VIEWTAG" ); Verbose( "Viewpath: $VIEWPATH" ); Verbose( "Viewdir : $VIEWDIR" ); # # If the user has specified a "source path", then we can extract the VOB # from that path. It will be the first directory # Verbose("Locate Source VOB"); if ( $opt_path ) { $opt_path =~ tr~\\/~/~s; $opt_path =~ s~/+$~~; Error( "Source Path needs leading '/'") unless ( $opt_path =~ m~^/~ ); Error( "Source Path is a UNC" ) if ( $opt_path =~ m~^//~ ); Error( "Source Path has drive specifier" ) if ( $opt_path =~ m~^[A-Za-z]\:~ ); # # Extract the VOB from the path # unless ( $opt_vob ) { my $vob = $opt_path; $vob =~ s~^/~~g; $vob =~ s~/.*~~g; $opt_vob = $vob; Verbose ("Extract VOB from path: $vob" ); } } # # If the view currently exists then it will be deleted if allowed # delete_view() unless ( $opt_reuse ); # # If the user is simply deleting the view then all has been done # exit 0 if ( $opt_delete ); # # Setup user specified VOB # if ( defined($opt_vob) ) { $ROOT_VOB = "/$opt_vob"; $ROOT_VOB =~ s~//~/~g; @ROOT_VOBS = $ROOT_VOB; } else { # # Extend the list of ROOT_VOBS with all the known vobs # The initial ROOT_VOBS are treated as a "hint" to assist searching # my $cmd = ClearToolCmd ('lsvob', '-short'); open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!"); while () { # # Filter output from the user # chomp; s~^$UNIX_VOB_PREFIX~~ if ($UNIX); Verbose2("lsvob: $_"); tr~\\/~/~s; push @ROOT_VOBS, $_; } close(CMD); } # # Ensure that the label is present within the specified VOB # Hunt for the user specified label in a number of well known VOBs # if ( @opt_spec ) { Verbose("Ensure Label is found in a VOB"); my $found = 0; my $spec = $opt_spec[0]; foreach my $vob ( @ROOT_VOBS ) { $vob = $UNIX_VOB_PREFIX . $vob if ( $UNIX ); (my $vob_name = $vob) =~ s~/~$VOB_SEP~g; Verbose2 ("Examine label $spec in vob: $vob" ); my $cmd = ClearToolCmd ('lstype', "lbtype:$spec\@$vob_name"); my $cmd_done = 0; open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!"); while () { # # Filter output from the user # Stay in loop to avoid Broken Pipe message # chomp; Verbose2("lstype: $_"); next if ( $cmd_done ); next if ( m~Error~ ); next unless ( m~label type~ ); push @label_not_locked, $spec unless( m~\(locked\)~ ); $label_count++; $found = $vob; $cmd_done = 1; } close(CMD); last if ( $found ); } Error ('ExitCode=11', "Label $spec not found in @ROOT_VOBS") unless ( $found ); Verbose ("Label $spec found in vob: $found" ); $ROOT_VOB = $found; # # Create a VOB spec extension # $root_vob_spec = '@' . $ROOT_VOB; $root_vob_spec =~ s~/~$VOB_SEP~g; # # Ensure that all labels are found in the VOB # foreach my $spec ( @opt_spec[1..$#opt_spec] ) { $label_count++; Verbose ("Testing label $spec in vob: $ROOT_VOB" ); my $data = qx( cleartool lstype lbtype:$spec$root_vob_spec ); Verbose ( "lstype: $data" ); Error ("Label $spec not found in $ROOT_VOB. All labels must be in the same VOB") if ( ! $data ); push @label_not_locked, $spec unless( $data =~ m~\(locked\)~ ); } # # Ensure that the branch is found in the VOB # if ( $opt_branch ) { Verbose ("Testing branch $opt_branch in vob: $ROOT_VOB" ); my $data = qx( cleartool lstype brtype:$opt_branch$root_vob_spec ); Verbose ( "lstype: $data" ); Error ("Branch $opt_branch not found in $ROOT_VOB.") if ( ! $data ); } # # Lock the label(s) # if ( $opt_lock ) { my @still_not_locked; Message( "Locking labels" ); foreach my $spec ( @label_not_locked ) { Verbose ("Locking $spec"); push @label_locked, $spec; ClearCmd ('lock', "lbtype:$spec$root_vob_spec" ); push @still_not_locked, $spec if ( @error_list ); } @label_not_locked = @still_not_locked; # # Register function to unlock all the locked lables on failure # ErrorConfig ('on_exit' => \&unlock_on_error ); Error ("Not all labels locked: @label_not_locked") if ( @label_not_locked ); } } # # Create a new (static) view # Create a config spec and populate the view # if (! -d $VIEWDIR || ! $opt_reuse ) { Message( "Create the view" . ($GBE_SANDBOX ? " in a SANDBOX" : "")); my $view_comment = "ViewDir: $VIEWDIR"; $view_comment .= " Created: " . localtime; # # Tried creating a co-located view under Windows, but had problems # 1) Did not work on WindowsServer based build machine ?? # 2) Deleting the view could be a problem if the user had # files open in the view. # 3) Documentation doesn't really like the use of -colocated # foreach my $view_count ( 1 .. 5 ) { my $cc_race_condition; my $cmd = ClearToolCmd ('mkview', '-snapshot', '-tag', $VIEWTAG, '-tcomment', $view_comment, $VIEWDIR); open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!"); @error_list = (); while () { # # Filter output from the user # chomp; tr~\\/~/~s; push @error_list, $_ if ( m~Error:~ ); Verbose2("mkview: $_"); # # Detect Race condition # Multiple build daemons creating views too fast for ClearCase # ClearCase can hit a race condition and fail to create a view # if ( $_ =~ m~Error: Unable to create directory "[^"]+": File exists\.~ ) { $cc_race_condition = 1; } } close(CMD); # # Race condition detected # Back-off and try again. Will only try a limited number of times # if ( $cc_race_condition ) { Message ("ClearCase Race condition detected"); sleep ( $view_count ); next; } last; } Error ("Cannot locate the created static view", @error_list) unless ( -d $VIEWDIR ); # In order to operate in this view (ie set the config spec, we need to # be in the directory of the view # chdir ($VIEWDIR) or Error( "Cannot chdir to $VIEWDIR"); # # Create a local package archive # May be needed for multipackage builds and it will prevent JATS from # finding any outside the view # mkdir ( 'local_dpkg_archive') unless ($GBE_SANDBOX); my $config_file = $opt_config_spec; unless ( $config_file ) { $config_file = create_config_spec ('config_spec.txt'); } Message( "Populating the view"); my $rv = ClearTool( 'setcs', '-tag', $VIEWTAG, $config_file ); } # Place a tag-file in the user-specified source path # This will be used by the build-tool to locate the 'source-path' of the # view, primarily for determining metrics. # # Calculate where the dynmaic view will be # This differ between UNIX/WINDOWS # if ( $opt_path && $GBE_ABT && !$opt_extract_files) { Message( "Create Build tagfile"); my $cpath = $VIEWDIR . $VOB_PREFIX . $opt_path; if ( -d $cpath ) { TouchFile ( "$cpath/.jats.packageroot" ); } } # # If we are only extracting files then ... # Remove the viewtag # Remove view-specific files # Eliminate 'vobs' subdirectory and move items up # if ( $opt_extract_files ) { # # Remove view tag - will be left with the view # Verbose3 ("Remove the viewtag"); chdir ( $user_cwd ); ClearCmd ( 'rmview', '-force', '-tag', $VIEWTAG ); # # Remove view specific files # chdir ( $VIEWDIR ) || Error ("Cannot cd to $VIEWDIR"); RmDirTree( 'local_dpkg_archive' ); RmDirTree( '.view.dat' ); foreach my $file ( glob ('update.*.updt') ) { RmDirTree( $file ); } # # Ensure that the VOB root was extracted # Error ('ExitCode=10', "Root directory not found: $VIEWDIR$ROOT_VOB") unless( -d $VIEWDIR . $ROOT_VOB ); # # Ensure some files were extracted # Error ('ExitCode=10', DisplayPath("View files in: $VIEWDIR, but no files were extracted")) unless ( $load_count ); # # If Unix based view, then get rid of the VOBS directory # if ( $UNIX ) { foreach my $file ( glob ('vobs/*') ) { my $target = $file; $target =~ s~^vobs/~~; rename $file, $target || Error ("Renaming $file. $!"); } rmdir 'vobs' || Error ("Removing vobs directory from: $VIEWDIR"); } Message DisplayPath("View files in: $VIEWDIR, Files: $load_count" ); exit (0); } # # Locate the JATS build files within the populated view # chdir ($VIEWDIR) or Error( "Cannot chdir to $VIEWDIR"); Message( "Locating build files"); my $bscanner = BuildFileScanner( "$VIEWDIR$ROOT_VOB", 'build.pl', '--LocateAll' ); $bscanner->scan(); my @build_list = $bscanner->getInfo(); foreach my $be ( @build_list ) { Message( DisplayPath ("Build file: $be->{dir} Name: $be->{file}")); } # # If we are extracting the view then we are done # Display useful information for the user # if ( $opt_extract ) { Message DisplayPath "View in: $VIEWDIR"; Warning ("No build files found" ) if ( $#build_list < 0 ); Warning( "Multiple build files found" )if ( $#build_list > 0 ); Message ("Not all labels are locked") if ( @label_not_locked ); Message ("All labels are locked") unless ( @label_not_locked ); Message ("Development Sandbox") if ( $GBE_SANDBOX ); exit 0; } Error ("No build files found") if ( $#build_list < 0 ); # # Determine the list of builds to perform # Ensure that the user-requested build files are present # # The user specifies the build file, via the mangled package name # This is package_name . project extension (daf_utils.cr) # if ( $#opt_build >= 0) { Verbose( "Check and locate the build files"); @build_list = (); foreach my $bentry ( @opt_build ) { if ($bscanner->match( $bentry) ) { UniquePush (\@build_list, $bscanner->getMatchList() ); Verbose ("Found: $bentry"); } else { Error ("Cannot locate requested build files for: $bentry") } } } # # Sanity test if we will transfer the generated package to dpkg_archive # There are some limits # 1) Must have built from one label # 2) That label must be locked # 3) Only one build file # 4) The view must not have been reused # 5) The view has a branch rule # 6) Building from a config spec # 7) Cannot release from a sandbox # my @elist; push @elist, "Package built from multiple labels" unless ( $label_count == 1 || $opt_config_spec ); push @elist, "Package built from an unlocked label" if ( @label_not_locked ); push @elist, "Package built with multiple build files" if ( scalar @build_list > 1 ); push @elist, "Package from a reused view" if ( $opt_reuse && ! $opt_beta ); push @elist, "Package from a development sandbox" if ( $GBE_SANDBOX ); push @elist, "View contains a branch" if ( $opt_branch ); push @elist, "Package based on a config spec" if ( $opt_config_spec ); push @elist, "User has specified build files" if ( $#opt_build > 0 ); if ( @elist ) { Warning ("Cannot officially release the package.", @elist); Error ("Build terminated as it cannot be released") if ($opt_dpkg && ! $opt_beta); } Warning ("Beta Release") if $opt_beta; # # Process each of the build files in the specified order # foreach my $be (@build_list) { # # We need to change to the build directory # Moreover we need the local name of the build directory. # Windows does not handle a UNC pathname to well (at all) # my $build_dir = $be->{dir}; chdir ("$build_dir") or Error( "Cannot chdir to build directory: $build_dir"); if ( $be->{file} =~ m/^build.pl$/ ) { Message ("Using JATS: $build_dir"); # # Invoke JATS to build the package and make the package # my @build_args = qw(--expert --cache); push @build_args, '--cache' if $opt_cache; my $make_type = 'all'; $make_type = 'all_prod' if ( $opt_prod_build ); $make_type = 'all_debug' if ( $opt_debug_build ); JatsCmd('build', @build_args) and Error("Package did not build"); JatsCmd('make', $make_type, 'NODEPEND=1') and Error("Package did not make"); JatsCmd('install'); if ( $opt_runtests ) { JatsCmd('make', 'run_unit_tests') and Error("Tests did not run correctly"); } } else { # # Ant build files # my $pname = $be->{file}; Message ("Using ANT: $build_dir, $pname"); $pname =~ s~depends.xml$~.xml~; copy($be->{file}, "auto.xml"); JatsCmd('-buildfile', $pname, 'ant', 'build') and Error("Package did not build"); JatsCmd('-buildfile', $pname, 'ant', 'make_package') and Error("Package did not make_package"); } } # # Copy the generated packages # 1) dpkg_archive # 2) Users local directory # foreach my $be (@build_list) { my $build_dir = $be->{dir}; chdir ("$build_dir") or Error( "Cannot chdir to build directory: $build_dir"); if ( $opt_dpkg ) { Message ("Using: $build_dir"); my @create_opts = "-o"; push @create_opts ,"-m" if ( $opt_merge ); JatsCmd('-here', 'create_dpkg', @create_opts, '-pname', $be->{name}, '-pversion', $be->{version}) and $error++; } if ( $opt_copy ) { Message ("Copy package to $user_cwd"); copy_directory( 'pkg', $user_cwd, '' ); } # # Test structure of the package # Ensure that it has a descpkg file # Validate the package name and version # More important for ANT projects than JATS as JATS has a sanity test # if ( $opt_test ) { JatsCmd('-here', 'create_dpkg', '-test', '-pname', $be->{name}, '-pversion', $be->{version}) and $error++; } } Error ("Package not transferred") if ( $error ); # # Delete the view # if ( ! $opt_reuse && ! $error && ! $opt_keep ) { delete_view(); } else { Message( "View left in: $VIEWDIR" ); } Message ("End program"); exit 0; #------------------------------------------------------------------------------- # Function : delete_view # # Description : Delete a view # # Inputs : None # $VIEWTAG - name of the view # $VIEWDIR - path of the view # # Returns : # sub delete_view { my $cofound = 0; my $uuid; # # Simple delete # if ( $opt_extract_files ) { if ( -d $VIEWDIR ) { Message("Remove extracted files: $VIEWTAG"); RmDirTree( $VIEWDIR ); } } else { # # If the view physically exists then attempt to phyically remove it # if ( -d $VIEWDIR ) { # # Determine if there are any checked out files in the view # Message("Remove the view: $VIEWTAG"); Verbose("Look for checked out files"); chdir ( $VIEWDIR ); foreach my $file ( glob ('*') ) { next if ( $file =~ m~local_dpkg_archive~ ); next if ( $file =~ m~^view\.~ ); if ( -d $file ) { Verbose ("Examine $file for checked out files"); chdir "$VIEWDIR/$file"; my $cmd = ClearToolCmd('lsco', '-cview', '-rec' ); open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!"); while () { # # Filter output from the user # chomp; Verbose("lsco: $_"); if ( m~checkout version~ ) { $cofound++ ; Warning ("Checked out file: $_"); } } close(CMD); } } Error ("Will not delete view. Checked out files exist") if ( $cofound ); # # Get out of the view # Cannot delete the view if we are in it. # chdir ( $user_cwd ); # # Static views should be removed by dirname, not by tag # ClearTool( 'rmview', $VIEWDIR ); # # Now try to delete the directory # RmDirTree( $VIEWDIR ); } # # If the view tag still exists then delete the view the hard way # Use 'lsview' to locate the views uuid # Verbose("Look for View Tag"); my $cmd = ClearToolCmd ('lsview', '-long', $VIEWTAG ); open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!"); while () { # # Filter output from the user # chomp; Verbose("lsview: $_"); $uuid = $1 if ( m~^View uuid:\s+(.*)~ ); } close(CMD); if ( $uuid ) { Warning ("Deleting view - the hard way"); ClearTool( '--Quiet', 'rmview', '-force', '-all', '-uuid', $uuid ); ClearTool( '--Quiet', 'unregister', '-view', '-uuid', $uuid ); ClearTool( '--Quiet', 'rmtag','-view', '-all', $VIEWTAG ); } } Error ("View was not deleted") if ( -d $VIEWDIR ); } #------------------------------------------------------------------------------- # Function : copy_directory # # Description : Copy a directory tree # # Inputs : Source directory # Target directory # Strip # # Should be full pathnames # # Returns : # my $copy_error; my $copy_count; sub copy_directory { our ($src_dir, $dest_dir, $strip) = @_; our $slength = length ($strip); # # Prevent File::Find from generating warnings # no warnings 'File::Find'; # # Helper routine to copy files # sub copy_file_wanted { # # Do not copy directories # Just make the directory entry. May result in empty directories # if ( -d $_ ) { my $tdir = "$dest_dir/" . substr( $File::Find::dir, $slength); $tdir .= "/$_"; File::Path::mkpath( $tdir ) unless ( -d $tdir); return; } # # When used to copy file from within a clearcase dynamic view the # files may not actually exist. This will generate an error later # so check for existance of file file now. # return unless ( -e $_ ); # # Have been chdir'ed to the source directory # when invoked # my $tdir = "$dest_dir/" . substr( $File::Find::dir, $slength); my $tfile = "$tdir/$_"; my $sfile = "$File::Find::dir/$_"; Verbose ("Copy: $sfile -> $tfile"); File::Path::mkpath( $tdir ) unless ( -d $tdir); unlink ( $tfile ) if ( -f $tfile ); if( ! File::Copy::copy ( $_ , $tfile ) ) { $copy_error++; Message "Error copying $sfile"; } else { my $perm = (stat $_)[2] & 07777; chmod($perm, $tfile); $copy_count++; } } # # Locate all files to copy # $copy_error = 0; $copy_count = 0; File::Find::find ( \©_file_wanted, $src_dir ); return $copy_error; } #------------------------------------------------------------------------------- # Function : ClearTool # # Description : Issue a cleartool command # Filter out many of the stupid messages # # Inputs : Options and Command line # Options: # --Quiet - Supress all command output # # Returns : Error code # sub ClearTool { my $quiet; $load_count = 0; # # Scan for initial options # --Quiet # if ( $_[0] eq '--Quiet' ) { $quiet = 1; shift; } my $cmd = ClearToolCmd(@_); open(CMD, "$cmd 2>&1 |") || Error "can't run command: $!"; while () { # # Filter output from the user # $load_count++ if ( m'Loading ' ); next if ( $quiet ); if ( $opt_extract_files ) { next if ( m'Loading ' ); next if ( m'Done loading ' ); next if ( m'Log has been written to ' ); } unless ( $opt_verbose ) { next if ( m~Making dir~ ); next if ( m~End dir~ ); next if ( m~Processing dir~ ); next if ( m~Error~ ); } print $_; } close(CMD); Verbose2 "ClearTool Exit Status: $?"; return $? / 256; } #------------------------------------------------------------------------------- # Function : ClearCmd # # Description : Execute a cleartool command # Capture error messages only # # Inputs : Command to execute # Takes an array of command argumeents and will quote them # # Returns : Exit code # Also the global @error_list # sub ClearCmd { @error_list = (); my $cmd = ClearToolCmd(@_); open(CMD, "$cmd 2>&1 |") || Error "can't run command: $!"; while () { chomp; Verbose ($_); push @error_list, $_ if ( m~Error:~ ); } close(CMD); Verbose2 "Exit Status: $?"; return $? / 256; } #------------------------------------------------------------------------------- # Function : ClearToolCmd # # Description : Create a nice escaped cleartool command # # Inputs : An array of cleartool command line arguments # # Returns : A string that has been quoted # sub ClearToolCmd { my $cmd = 'cleartool ' . QuoteCommand( @_); Verbose2 $cmd; return $cmd; } #------------------------------------------------------------------------------- # Function : unlock_on_error # # Description : Error cleanup function. # Called by the error processing # Called to unlock all labels that have been locked by this # utility # # Inputs : @label_locked - Labels locked by this utility (Global) # # Returns : # sub unlock_on_error { my @still_locked; Message( "Releasing Locked labels" ); foreach my $spec ( @label_locked ) { Verbose ("Unlocking:$spec"); ClearCmd ('unlock', "lbtype:$spec$root_vob_spec" ); push @still_locked, $spec if ( @error_list ); } Error ("Not all labels unlocked: @still_locked") if ( @still_locked ); } #------------------------------------------------------------------------------- # Function : create_config_spec # # Description : Creates a config spec # # Inputs : $config - Path to the config file # # Returns : Path to the config spec # sub create_config_spec { my ($config_file) = @_; # # Calc the path to a directory in the view which we really want to # consider as the base. Only want to see folders above this base. # Don't want to add elements above the base # my $basepath = ($opt_path) ? "\"${VOB_PREFIX}${opt_path}\"" : $ROOT_VOB; my $elroot = ($opt_path) ? "\"${VOB_PREFIX}${opt_path}/...\"" : '*'; my $elpath = ($opt_path) ? $opt_path : ''; # # Create a config spec to be used to populate the view # Do not branch directories # Do not extract files from lost+found # Verbose( "Create config spec"); my @config; push @config, "element * CHECKEDOUT"; push @config, "element .../lost+found -none"; # # Insert rules to prevent branching above the load path # This will be the root of the package # if ( $opt_path ) { my $fulldir = $VOB_PREFIX; my @parts = split ('/', $opt_path); shift @parts; # Skip first as its empty pop @parts; # Skip last as its the package foreach my $dir ( @parts ) { $fulldir .= "/$dir"; foreach (@opt_spec) { push @config, "element -dir \"$fulldir\" $_ -nocheckout"; } } } else { foreach (@opt_spec) { push @config, "element -dir \"$ROOT_VOB\" $_ -nocheckout"; } } # # General branching rules # Rule will apply to all following directives # if ( $opt_branch ) { push @config, "element $elroot .../$opt_branch/LATEST"; push @config, "mkbranch $opt_branch"; } # # Rules to extract elements within the load path # foreach (@opt_spec) { push @config, "element $elroot $_"; } # # KLUDGE ALERT # Packages SHOULD be labled to the root. # Do not extend this list fix the package - fix the labels in the VOB. # if ( $opt_latest_root ) { push @config, "element -dir $ROOT_VOB .../$opt_latest_root/LATEST"; push @config, "element -dir $ROOT_VOB .../mass_dev2/LATEST"; push @config, "element -dir $ROOT_VOB .../mass_dev/LATEST"; push @config, "element -dir $ROOT_VOB /main/LATEST"; } # # Handle file(directory) addition # Need a rule to allow /main/0 to be visible # Need to ensure that we don't "see" the entire VOB, just below the load path # unless ($GBE_ABT || $opt_extract_files) { # # Ensure that we have more than just the VOB root # If we only have the VOB root then we will get all top level entries # in the vob - and this is not good. # # Comment out the rule so that the user can use if they must # my $count = ($elpath =~ tr~/~~); my $prefix = ( $count <= 1 ) ? '# ' : ''; Verbose2 ("Config Spec: Suppress /main/0. Path too short)") if $prefix; # # Ensure that element-0 is visible (unless autobuilder) # Note: mkbranch rule will modify this rule # push @config, $prefix . "element $elroot /main/0"; } # # Load rule # Quote the path so that spaces will be correcly handled # push @config, "load $basepath"; Message ("Config Spec", @config ) if ( IsVerbose(1) ); FileCreate ($config_file, \@config); return $config_file; } #------------------------------------------------------------------------------- # Documentation # =pod =for htmltoc GENERAL::ClearCase:: =head1 NAME jats_ccrelease - Build a package given a clearcase label =head1 SYNOPSIS jats ccrelease [options] [-label=]label | -config=config_spec Options: -help - brief help message -help -help - Detailed help message -man - Full documentation -label=xxx - Clearcase label -spec=xxx - Same as -label=xxx -path=xxx - Source Path -view=xxx - Modify the name of the created view -vob=vobname - VOB name -build=xxx - Package Name to build -root=xxx - Root directory for generated view -latestroot=xxx - Use the LATEST rootlevel directory 'xxx' -[mk]branch=xxx - Will create a view with a branch rule -config=xxx - Create a view with the provided config spec -tag=xxx - Alternate tag used with in the ViewTag -extract - Extract the view and exit -extractfiles - Extract files, without a view -cache - Refresh local dpkg_archive cache -delete - Remove any existing view and exit -debugOnly - Make only the debug version -prodOnly - Make only the production version -[no]dpkg - Transfer package into dpkg_archive -[no]copy - Transfer pkg directory to the current user directory -[no]reuse - Reuse the view -[no]test - Test package build. Implies nocopy and nodpkg -[no]keep - Keep the view after the build -[no]lock - Lock labels -[no]beta - Release a beta package -[no]merge - Merge packages into dpkg_archive -[no]runtests - Run units tests. Default is runtests -[no]prefix - Supress user prefix in view name. Default prefix is USER =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> or B<-spec> The ClearCase label to use as the base for the view. Eg: daf_utils_math_3.2.1 =item B<-view name> Specified an alternate view name and tag to be used. This option does not provide the full name of the view. The view tag will be : "${USER}_${MACHINENAME}_${TAG}_${NAME}" The view path will be: "${USER}_${NAME}" The default "NAME" is the first label specified. The default "TAG" is build. See B<-tag=tagname>. If the user provides a view "name" that is prefixed with their user name ('${USER}_'), then the username will be stripped of for internal processing. This allows a user to provide a view path when deleting a view. =item B<-path=xxx> Specifies the source path to the root of the extracted file tree. This option has several uses: =over 8 =item * Provide a sanity test of the "Source Path" item within Release Manager =item * Specify the VOB that contains the source. The VOB name will be extracted and used as the B<-vob> parameter. =item * Limit the work to do in extracting the file tree. =back =item B<-vob=xxx> Specifies the Clearcase VOB in which the clearcase label will be located. This is used as the basis for locating and loading the files within the view. By default this utility will examine all the VOBs for the label. =item B<-build=xxx> This option allows the user to specify the packages to be built and the order in which the packages are to be built. This is useful if the extracted view contains multiple build files This option may be used multiple times. There are two forms in which the build target can be specified. It can be specified as a full package name and vesrion, or as a package name and the project suffix. By default the program will assume that there is only one build file in the view and will not build if multiple files are present, unless the package to be built can be resolved. The location mechanism operates for both JATS and ANT build files. Example: -build=jats-api.1.0.0000.cr This will locate the build file that builds version 1.0.0000.cr of the jats-api package. The version numbers must match exactly. Example: -build=jats-api.cr -build=jats-lib.cr This will located the build files that build the jats_api (cr) package and the jats-lib (cr) package. The version of the packages will not be considered. =item B<-root=xxx> This option allows the location of the generated view to be specified on the command line. It overides the value of GBE_VIEWBASE. If the comamnd is invoked within a development sandbox, then the default location will be the root directory of the development sandbox. =item B<-latestroot=xxx> This option enables a work around for a bad-labelling practice that has existed in the past. This LATEST version of the named (xxx) branch will be added to the config spec used to create the view. This is a work around for a problem where the top-level directory in the VOB has not been labelled. This can result in unreproducible builds. This option allows the utility to construct a view, but the user SHOULD label the root level directory to correct the problem. The use of this switch will add the following lines to the config spec: element -directory /DPG_SWBase /main/xxxx/LATEST =item B<-branch=xxx or -mkbranch=xxx> This option will create a view such that files that are checked out will be checked out on the named branch. This is intended to facilitate the maintenance of existing packages - the creation of a patch. The named branch must exist within the VOB containing the label. The script will check for its existence. The use of this switch will add the following lines to the config spec: element * .../xxx/LATEST element * label -mkbranch xxx element * /main/0 -mkbranch xxx =item B<-config=config_spec> This option is an alternate mechanism to create a static view. The view will be based on the provided configuration spec. This view cannot be used to release a package. The option is intended to simplify development. This option is incompatibale with: -release -label -branch -path -vob =item B<-tag=text> This option alters the ClearCase view tag created for the view. It allows the creation of multiple views based on the same label. Intended to be used in the automated build system to create unique views tags. The default tag is 'build'. =item B<-extract> With this option the view is created and the left in place. The user may then access the files within the view. The view should not be used for a production release. =item B<-extractfiles> With this option the utility will create a dynamic view and transfer files from the view to the user's tararget. The dynamic view is then removed. This command is intended to simplify the process of creating an escrow. =item B<-cache> Forces external packages to be placed in the local dpkg_archive cache. The normal operation is to copy the packages, only if they do not already exist in the local cache. This option may be used to ensure that the local copy is correct and up to date. =item B<-delete> Delete the view used by the program, if it exists. This option may be used to cleanup after an error. Note: Ensure that no files are open in the view and that the users current working directory is not in the view as these will prevent the view from being deleted. =item B<-debugOnly> Make only the debug version of the package. The default it to create both the debug and production version of the package. The type of build may be further limited by options within the package. =item B<-prodOnly> Make only the production version of the package. The default it to create both the debug and production version of the package. The type of build may be further limited by options within the package. =item B<-[no]dpkg> Copy the generated package into dpkg_archive. This is the default mode of operation. =item B<-[no]copy> Copy the built "pkg" directory to the users current directory. The entire "pkg" subdirectory includes the full package named directory for the package that has been built. =item B<-[no]reuse> This flag allows the view created by the program to be re-used. =over 8 =item * The view is not deleted before being populated. =item * The view will not be populated if it does exist. =item * The view will not be deleted at the end the process. =back This option is useful for debugging a build process. =item B<-[no]test> Test the building of the package. This option implies "nocopy" and "nodpkg". =item B<-[no]keep> Keep the clearcase view after the build. The default option is "nokeep" This option is different to the "reuse" in that the view will be deleted, if it exists, before the build, but will be retained at the completion of the process. The user may then manually extract the created package. The view may be deleted with the the "delete" option; taking care to ensure that no files are open in the view and that the users current working directory is not in the view. =item B<-[no]lock> Lock any unlocked labels before attempting the build. This operation may be used to ensure that a release build does not fail due to the labels not being locked. The label is locked before the view is constructed and populated. This operation may fail if the user does not "own" the label. =item B<-[no]beta> This option overrides many of the package release tests to allow a beta package to be released. =item B<-[no]merge> This option will merge packages being built on multiple machines into dpkg_archive. By default, if a package already exists in the archive it will be deleted and replaced. With this option the package will be merged. The merge process does not over write files found in the archive. =item B<-[no]runtests> This option will allow the suppression of the running of the unit tests included with the component. By default the tests are run. This can be suppressed without affecting the release process. =back =head1 DESCRIPTION This program is the primary tool for the creation, recreation and release of packages within the B build environment, although the program can perform a number of very useful operations required during normal development and maintenance. This program will build a system containing one or more inter-related build files using the JATS build tools. In normal operation the program will: =over 8 =item Remove View Remove any existing view of the same name. The view will not be removed if it contains checked-out files. The view removal may fail if there are any files B within the view or if any shell has a subdirectory of the view set as a B. =item Locate VOB Locate the VOB that contains the specified label or labels. If multiple labels are specified they must all exist in the same VOB. =item Lock Labels Lock any unlocked labels, if required. =item Create the view Create a static view to containing the files describes by the Clearcase label being processed. The program uses a fixed view name. If this view exists then item will be deleted before item is created again. Each build starts in a clean view. =item Populate the View Loads files into the static view. The user label and the VOB name are used to created a clearcase configuration specification. This configuration specification is then activated and all files within the specified VOB will be loaded into the view if they match the user supplied label. This processed normally results in a lot of error messages that can be ignored. I The label placed on the component to be built must extend to the root of the VOB, otherwise the directory path will not be extracted nor will the files within the component. I If the view is simply being extracted, then this is the end of the program. The extracted view is left in place. =item Sanity Test If the build is being used as a release into dpkg_archive then various tests are performed to ensure the repeatability of the view and the build. These tests include: =over 8 =item * The view must be constructed from one label =item * That label must be locked =item * The labelled view must contain exactly one build file =item * The view cannot have been re-used. =back =item Locate build files Locate the build file within the view. It is an error to have multiple build files within the view, unless the B<-build> option is used. By default, only one package will be built. =item Package the results Use JATS to build and make the package. The resultant package may be copied to a numbers of locations. These include =over 8 =item 1 The master dpkg_archive as an official release. This is the default operation. =item 2 The users current directory. The package directory from the built package is copied locally. The "pkg" directory is copied. This is only performed with the B<-copy> option. =back =item Delete the view Delete the view and all related files. The view will not be deleted if an error was detected in the build process, or the "reuse" or "keep" options are present. =back =cut