Rev 227 | Blame | Compare with Previous | Last modification | View Log | RSS feed
# interpreter optionsuse strict;#use warnings;# perl librariesuse Cwd;use Carp;use DirHandle;use FileHandle;use File::Compare;use File::Copy;use Getopt::Long;#==================================================================================================## module global constants# none#==================================================================================================## module global variables# none#==================================================================================================# preserve the command line for later output to the log filemy $commandLine;$0 =~ m%\\?([^\\]*$)%; # strip off any leading path stuff$commandLine = $1 . " " . join( " ", @ARGV );#==================================================================================================# define the command line options we accept# NOTE: don't forget to update the help text if you play with these...# NOTE: these are globals too, lited here to associate them with the option routines...my $opt_destinationDir;my $opt_sourceDirectory;my $opt_dryRun;my $opt_log;my $opt_recurse;my $opt_admin;my $opt_label;my $opt_comment;my $opt_noClearcase;my $opt_noViewCheck;my $opt_noDelete;my $opt_noCheckin;my $opt_noBranch;my %gOptionList;%gOptionList =("dest=s" => sub # where to place the files{$_[1] =~ s%\\%/%g;$opt_destinationDir = $_[1];},"src=s" => sub # where the files come from{$_[1] =~ s%\\%/%g;$opt_sourceDirectory = $_[1] ;},"dryRun!" => \$opt_dryRun, # if set, display what would happen, don't# actually do it"log=s" => \$opt_log, # nominate the log file to output to"recurse!" => \$opt_recurse, # specify whether we're to recurse or not"admin=s" => \$opt_admin, # specify the administrative vob to create the label in"label=s" => \$opt_label, # specify a label to apply"comment=s" => \$opt_comment, # specify a comment to go with the label"noClearCase!" => \$opt_noClearcase, # specify whether clearcase is involved or not"noViewCheck!" => \$opt_noViewCheck, # specify whether clearcase view check to be done or not"noDelete!" => \$opt_noDelete, # specify whether to delete files not in source# but in destination"noCheckin!" => \$opt_noCheckin, # set means don't check in the files..."noBranch!" => \$opt_noBranch, # set means check file out without branching"help!" => \&giveHelp, # provide the punter with help);#==================================================================================================## main code body#==================================================================================================# recover any command line optionsGetOptions( %gOptionList );#==================================================================================================# verify that if specified, the labelling parameters are all specified# NOTE no check is made as to whether the vob is correct or the label can be created/usedunless( $opt_noClearcase || !defined $opt_label ){# do we have an administrative vob?die "No administrative VOB specified\n" unless ( $opt_admin );die "No label comment specified\n" unless ( $opt_comment );}#==================================================================================================# use stdout or nominated file for status output?my $statusFh;$statusFh = new FileHandle;if ( defined $opt_log ){# open up the nominated destinationunless ( open( $statusFh, "> $opt_log" ) ){die "Unable to open '$opt_log': $!\n";}}else{# duplicate stdoutunless ( open( $statusFh, ">-" ) ){die "Unable to dup 'STDOUT'\n";}}#==================================================================================================# record what the command line wasprint $statusFh $commandLine, "\n";#==================================================================================================# if a clearcase view & check not suppressed, verify it...doClearcaseViewCheck( $opt_destinationDir ) unless( $opt_noClearcase || $opt_noViewCheck );#==================================================================================================# locate all directories from here down (if required)doThisDirectory( $opt_sourceDirectory, $opt_destinationDir );#==================================================================================================# label this suckerdoLabel( $opt_destinationDir, $opt_admin, $opt_label, $opt_comment ) unless( $opt_noClearcase || !defined $opt_label );exit 0;##==================================================================================================## doClearcaseViewCheck## PERSISTENT LOCALS:# none#sub doClearcaseViewCheck#{## correct number of input parameters?if ( ($#_+1) != 1 ){confess "Incorrect parameter count, expected 1 parameter, saw ", $#_+1, "\n";}## INPUTS:my $destinationDir = shift; # IN - name of the directory containing destination elements## OUTPUTS:# none## GLOBALS:## NOTES:# none##==================================================================================================my $command;print $statusFh "Verifying destination view\n";# anything currently checked out?my @checkedout;$command = "cleartool lscheckout -short -recurse -me -cview $destinationDir";@checkedout = doClearCaseCommand( $command );if ( 0 <= $#checkedout ){chomp @checkedout;map( s%\\%/%g, @checkedout );print $statusFh "The following items are checked out:\n\t",join( "\n\t", @checkedout ), "\nAborting\n";exit -1 unless $opt_dryRun;}# collate list of source itemsmy @sources;$command = cleartool ls -short -recurse $destinationDir;@sources = doClearCaseCommand( $command );chomp @sources;map( s%\\%/%g, @sources );#now see if there's anything that isn't 'latest' and tell the user...my $item;my @naughtyList;foreach $item ( @sources ){# item managed by clearcase?next unless ( $item =~ /@@/ );next if ( $item =~ /CHECKEDOUT/ );# clearcase item, see if the viewed vbersion is the same as the latest on this branchmy $compare;$item =~ m%(^.*/)[0-9]+$%;$compare = $1 . "LATEST";my $result;$command = cleartool describe -short $compare;$result = doClearCaseCommand( $command );$result =~ s%\\%/%g;chomp $result;print $statusFh "Verifying: $item\n";if ( $item ne $result ){# we have a mismatch, record it for posterity...push @naughtyList, $item . " " x 5 . "=>" . " " x 5 . $result;}}# any items not at end of list?if ( 0 <= $#naughtyList ){print $statusFh "ERROR: The following elements are not the latest version:\n\t",join( "\n\t", @naughtyList ), "\nAborting\n";exit -1 unless $opt_dryRun;}} # doClearcaseViewCheck##==================================================================================================## doThisDirectory## PERSISTENT LOCALS:# none#sub doThisDirectory#{## correct number of input parameters?if ( ($#_+1) != 2 ){confess "Incorrect parameter count, expected 2 parameters, saw ", $#_+1, "\n";}## INPUTS:my $sourceDirectory = shift; # IN - name of the directory containing source elementsmy $destinationDir = shift; # IN - name of the directory containing destination elements## OUTPUTS:## GLOBALS:## NOTES:# none##==================================================================================================print $statusFh "Processing source directory '$sourceDirectory', and destination directory '$destinationDir'\n";# collate source filesprint $statusFh "Collating source files...\n";my $refSourceFiles;my $refSourceDirs;( $refSourceDirs, $refSourceFiles ) = collateFileList( $sourceDirectory );# collate destination filesprint $statusFh "\n";print $statusFh "Collating destination files...\n";my $refDestinationFiles;my $refDestinationDirs;( $refDestinationDirs, $refDestinationFiles ) = collateFileList( $destinationDir );# are we recursing down?if ( defined $opt_recurse ){print $statusFh "Recursing down...\n";my @newDirs;my @commonDirs;my @deletedDirs;arrayDiff( $refSourceDirs,$refDestinationDirs,\@newDirs,\@commonDirs,\@deletedDirs );print $statusFh "New directories are:\n\t", join( "\n\t", @newDirs ), "\n";print $statusFh "Common directories are:\n\t", join( "\n\t", @commonDirs ), "\n";print $statusFh "Deleted directories are:\n\t", join( "\n\t", @deletedDirs ), "\n";# yep, go handle any new directoriesforeach ( @newDirs ){print $statusFh "New directory, making '${destinationDir}/$_'\n";unless ( $opt_dryRun ){# make the directorymkdir "${destinationDir}/$_";# add it to CC controlunless ( $opt_noClearcase ){# for new directories, not sure how to get it to NOT branch...print $statusFh "Adding '${destinationDir}/$_' to ClearCase.\n";doClearCaseCommand( "cleartool mkelem -eltype directory -ci -ncomment ${destinationDir}/$_" );}# now recurse to it...doThisDirectory( "${sourceDirectory}/$_", "${destinationDir}/$_" );# and check it back in...unless ( $opt_noClearcase || $opt_noCheckin ){print $statusFh "Checking in '${destinationDir}/$_'\n";doClearCaseCommand( "cleartool ci -ncomment ${destinationDir}/$_" );}}}# and the common ones...foreach ( @commonDirs ){print $statusFh "Processing common Directory '${destinationDir}/$_'\n";doThisDirectory( "${sourceDirectory}/$_", "${destinationDir}/$_" );}# just nuke the deleted ones...if ( 0 <= $#deletedDirs ){unless ( $opt_noDelete ){print $statusFh "Deleting non-existent directory '${destinationDir}/$_'\n";unless ( $opt_dryRun ){# check out the diestination dorectory...unless ( $opt_noClearcase ){print $statusFh "Checking out parent directory '$destinationDir' to allow deletion\n";unless ( $opt_noBranch ){# use config spec rules for branching...doClearCaseCommand( "cleartool co -reserved -ncomment $destinationDir" );}else{# suppress config spec branching rulesmy @description;@description = doClearCaseCommand( "cleartool describe $destinationDir" );my $version;foreach ( @description ){# search for the directory version...if ( m/version.*"(.*)"$/ ){$version = $1;last;}}doClearCaseCommand( "cleartool co -reserved -ncomment -version $version" );}}# nuke the offending elements...foreach ( @deletedDirs ){# nuke it...print $statusFh "Deleting '${destinationDir}/$_'\n";doClearCaseCommand( "cleartool rm ${destinationDir}/$_" );}# and check it back in...unless ( $opt_noClearcase || $opt_noCheckin ){print $statusFh "Deletion complete, checking in parent directory '$destinationDir'\n";doClearCaseCommand( "cleartool ci -ncomment ${destinationDir}" );}}}}}# let's 'hash-it-out' to locate new and deleted files...my @newFiles;my @commonFiles;my @deletedFiles;arrayDiff( $refSourceFiles,$refDestinationFiles,\@newFiles,\@commonFiles,\@deletedFiles );print $statusFh "New files are:\n\t", join( "\n\t", @newFiles ), "\n";print $statusFh "Common files are:\n\t", join( "\n\t", @commonFiles ), "\n";print $statusFh "Deleted files are:\n\t", join( "\n\t", @deletedFiles ), "\n";updateFiles( $sourceDirectory, $destinationDir, \@newFiles, \@commonFiles, \@deletedFiles );} # doThisDirectory##==================================================================================================## doLabel## PERSISTENT LOCALS:# none#sub doLabel#{## correct number of input parameters?if ( ($#_+1) != 4 ){confess "Incorrect parameter count, expected 2 parameters, saw ", $#_+1, "\n";}## INPUTS:my $destinationDir = shift; # IN - name of the directory containing destination elementsmy $adminVob = shift; # IN - label to applymy $label = shift; # IN - label to applymy $comment = shift; # IN - comment to apply to the label## OUTPUTS:## GLOBALS:## NOTES:# none##==================================================================================================my $command;# tidy up inputs$destinationDir =~ s%\\%/%g;$adminVob = "/" . $adminVob unless ( $adminVob =~ m%^/% );# create the label in the admin vobmy $createResult;$command = "cleartool mklbtype -global -c \"$comment\" ${label}\@${adminVob}";print $statusFh "Creating the label '$command'\n";$createResult = doClearCaseCommand( $command ) unless $opt_dryRun;# apply the label to the destinationmy @labelResult;$command = "cleartool mklabel -recurse $label $destinationDir";print $statusFh "Labelling '$command'\n";@labelResult = doClearCaseCommand( $command ) unless $opt_dryRun;# now walk our way back up the directory tree labelling the inbetween directorys neededwhile ( $destinationDir =~ m%/% ){# go backwards one directory$destinationDir =~ m%(^.*)/[^/]+$%;$destinationDir = $1;# have we reached the root yet?last if $destinationDir =~ /^[A-Za-z]:$/;last if $destinationDir =~ /^\s*$/;#not at root, so apply labelpush @labelResult, doClearCaseCommand( "cleartool mklabel ${label}\@ ${destinationDir}" )unless $opt_dryRun;}# report on what's labelledchomp @labelResult;print $statusFh "Label result:\n\t",join "\n\t", @labelResult, "\n";# and finally, lock the suckerdoClearCaseCommand( "cleartool lock lbtype:$label" ) unless $opt_dryRun;} # doLabel##==================================================================================================## collateFileList## PERSISTENT LOCALS:# none#sub collateFileList#{## correct number of input parameters?if ( ($#_+1) != 1 ){confess "Incorrect parameter count, expected 1 parameter, saw ", $#_+1, "\n";}## INPUTS:my $searchDirectory = shift; # IN - the nominated directory to search for items## OUTPUTS:# none## GLOBALS:# none## NOTES:# none##==================================================================================================# open the directory to get the file list...my $dirHandle;$dirHandle = new DirHandle;opendir( $dirHandle, $searchDirectory ) or die "Unable to open '$searchDirectory': $!\n";# now go get the file list...my $dirEntry;my @fileList;my @dirList;while ( $dirEntry = readdir( $dirHandle ) ){# do we have a valid directory?chomp $dirEntry;next if $dirEntry eq ".";next if $dirEntry eq "..";# do we have a file or directory to parse?if ( -d "${searchDirectory}/${dirEntry}" ){# directory, are we recursing??if ( defined $opt_recurse ){# yep, so let's do it...print $statusFh "Adding ${dirEntry} to the directory list...\n";push @dirList, "${dirEntry}";}}else{# we've a file, add it to the file listprint $statusFh "Adding ${dirEntry} to the file list...\n";push @fileList, "${dirEntry}";}}closedir( $dirHandle );return \@dirList, \@fileList;} # collateFileList##==================================================================================================## arrayDiff## PERSISTENT LOCALS:# none#sub arrayDiff#{## correct number of input parameters?if ( ($#_+1) != 5 ){confess "Incorrect parameter count, expected 5 parameters, saw ", $#_+1, "\n";}## INPUTS:my $refSourceArray = shift; # IN - reference to an array of source itemsmy $refDestinationArray = shift; # IN - reference to an array of destination itemsmy $refNewArray = shift; # I/O - reference to an array to populate with new itemsmy $refCommonArray = shift; # I/O - reference to an array to populate with common itemsmy $refDeletedArray = shift; # I/O - reference to an array to populate with deleted items## OUTPUTS:## GLOBALS:## NOTES:# none##==================================================================================================# prepare to locate new, common and deleted directories...my %sourceHash;my %destinationHash;map { $sourceHash{$_} = $_ } @{$refSourceArray};map { $destinationHash{$_} = $_ } @{$refDestinationArray};# new...foreach ( keys %sourceHash ){# keep list of common filespush ( @{$refNewArray}, $_ ) unless exists $destinationHash{$_};}# common...foreach ( keys %sourceHash ){# keep list of common filespush ( @{$refCommonArray}, $_ ) if exists $destinationHash{$_};}# deleted...foreach ( keys %destinationHash ){# keep list of common filespush ( @{$refDeletedArray}, $_ ) unless exists $sourceHash{$_};}} # arrayDiff##==================================================================================================## updateFiles## PERSISTENT LOCALS:# none#sub updateFiles#{## correct number of input parameters?if ( ($#_+1) != 5 ){confess "Incorrect parameter count, expected 5 parameters, saw ", $#_+1, "\n";}## INPUTS:my $sourceDir = shift; # IN - name of the source directorymy $destinationDir = shift; # IN - name of the destination directorymy $refNewFiles = shift; # IN - reference to an array of new filesmy $refcommonFiles = shift; # IN - reference to an array of common filesmy $refDeletedFiles = shift; # IN - reference to an array of deleted files## OUTPUTS:## GLOBALS:## NOTES:# none##==================================================================================================my $fileName;# just add the new files to CC control...if ( 0 <= $#{$refNewFiles} ){unless ( $opt_noClearcase || $opt_dryRun ){print $statusFh "Checking out parent directory '$destinationDir' to allow addition\n";unless ( $opt_noBranch ){# use config spec rules for branching...doClearCaseCommand( "cleartool co -reserved -ncomment $destinationDir" );}else{# suppress config spec branching rulesmy @description;@description = doClearCaseCommand( "cleartool describe $destinationDir" );my $version;foreach ( @description ){# search for the directory version...if ( m/version.*"(.*)"$/ ){$version = $1;last;}}doClearCaseCommand( "cleartool co -reserved -ncomment -version $version" );}}foreach $fileName ( @{$refNewFiles} ){# copy file across, then add it to CC controlprint $statusFh "Copying '${sourceDir}/${fileName}' to '${destinationDir}/${fileName}'\n";unless ( $opt_dryRun ){copy( "${sourceDir}/${fileName}", "${destinationDir}/${fileName}" );unless ( $opt_noClearcase ){print $statusFh "Adding '${destinationDir}/${fileName}' to ClearCase control\n";doClearCaseCommand( "cleartool mkelem -eltype file -ci -ncomment ${destinationDir}/${fileName}" );}}}# no need to check-in directory if there are files to be deletedif ( 0 > $#{$refDeletedFiles} ){unless ( $opt_noClearcase || $opt_dryRun || $opt_noCheckin ){print $statusFh "Addition complete, checking in parent directory '$destinationDir'\n";doClearCaseCommand( "cleartool ci -ncomment $destinationDir" );}}}# find the common files that are different, update the different ones under clearcase controlforeach $fileName ( @{$refcommonFiles} ){# do we have matching files?next if ( 0 == compare( "${sourceDir}/${fileName}", "${destinationDir}/${fileName}" ) );# they differprint $statusFh "Files '${sourceDir}/${fileName}' and '${destinationDir}/${fileName} are different\n";# files differ! so check out the destination...unless ( $opt_noClearcase || $opt_dryRun ){print $statusFh "Checking out '${destinationDir}/${fileName}'\n";unless ( $opt_noBranch ){# use config spec rules for branching...doClearCaseCommand( "cleartool co -reserved -ncomment ${destinationDir}/${fileName}" );}else{# suppress config spec branching rulesmy @description;@description = doClearCaseCommand( "cleartool describe ${destinationDir}/${fileName}" );my $version;foreach ( @description ){# search for the file version...if ( m/version.*"(.*)"$/ ){$version = $1;last;}}doClearCaseCommand( "cleartool co -reserved -ncomment -version $version" );}}# copy the new file over the topunless ( $opt_dryRun ){print $statusFh "Copying '${sourceDir}/${fileName}' to '${destinationDir}/${fileName}'\n";copy( "${sourceDir}/${fileName}", "${destinationDir}/${fileName}" );}# and check it back in againunless ( $opt_noClearcase || $opt_dryRun || $opt_noCheckin ){print $statusFh "Checking '${destinationDir}/${fileName}' in\n";doClearCaseCommand( "cleartool ci -ncomment ${destinationDir}/${fileName}" );}}# remove the deleted filesif ( 0 <= $#{$refDeletedFiles} ){unless ( $opt_noDelete ){# no need to checkout directory if we've added new fiesif ( 0 > $#{$refNewFiles} ){unless ( $opt_noClearcase || $opt_dryRun ){print $statusFh "Checking out parent directory '$destinationDir' to allow deletion\n";unless ( $opt_noBranch ){# use config spec rules for branching...doClearCaseCommand( "cleartool co -reserved -ncomment $destinationDir" );}else{# suppress config spec branching rulesmy @description;@description = doClearCaseCommand( "cleartool describe $destinationDir" );my $version;foreach ( @description ){# search for the directory version...if ( m/version.*"(.*)"$/ ){$version = $1;last;}}doClearCaseCommand( "cleartool co -reserved -ncomment -version $version" );}}}# now do each deleted fileforeach $fileName ( @{$refDeletedFiles} ){print $statusFh "Deleting '${destinationDir}/${fileName}'\n";unless ( $opt_noClearcase || $opt_dryRun ){doClearCaseCommand( "cleartool rm ${destinationDir}/${fileName}" );}}}unless ( $opt_noClearcase || $opt_dryRun || $opt_noCheckin || ( $opt_noDelete && ( 0 > $#{$refNewFiles} ) ) ){print $statusFh "Deletion complete, checking in parent directory '$destinationDir'\n";doClearCaseCommand( "cleartool ci -ncomment $destinationDir" );}}} # updateFiles##==================================================================================================## doClearCaseCommand## PERSISTENT LOCALS:# none#sub doClearCaseCommand#{## correct number of input parameters?if ( ($#_+1) != 1 ){confess "Incorrect parameter count, expected 1 parameter, saw ", $#_+1, "\n";}## INPUTS:my $command = shift;## OUTPUTS:## GLOBALS:## NOTES:# none##==================================================================================================# add the redirection stuff$command .= " 2>&1";# do the commandmy @commandResult = `$command`;# see if we had an errorif ( 0 != $? ){my $message;$message = "'$command' FAILED ($?): " . join( "", @commandResult) . "\n";print $statusFh $message;eval{ confess };print $statusFh $@;die $@;}# command succeededreturn @commandResult;} # doClearCaseCommand##==================================================================================================## giveHelp## provide the punters with some help...## PERSISTENT LOCALS:# none#sub giveHelp#{## correct number of input parameters?# IGNORED - no input parameters used or parsed!!!!## INPUTS:# none## OUTPUTS:# none## GLOBALS:# none## NOTES:# none##==================================================================================================my $exeName;# a slight bit of trickery to cater for those that like to rename things...$0 =~ m%\\?([^\\]*$)%; # strip off any leading path stuff$exeName = $1;# give 'em heaps....print <<EOF;Usage:$exeName [-dest <dir-name>] [-src=<dir-name>] [-dryRun] [-log <filename>] \[-recurse] [-noClearCase] [-noDelete] [-noBranch] [-help]Where:[-dest <dir-name>] Specify the destination directory.[-src <ext-name>] Specify the source directory.[-dryRun] Do not do anything, just pretend. NOTE: willnot recurse through new directories!!!![-log <filename>] Optionally specify a log file for the statusoutput information. If not used, output willgo to the screen.[-recurse] Recurse through directories for ALL sourcefiles.[-admin <vob-name] Specify the administrative vob to create thelabel in.[-label <label-name>] Specify a label name to apply.[-comment "<lbl-comment>"] Specify a comment to go with the label.[-noClearCase] Do not perform any clear case operations.[-noViewCheck] Specify whether clearcase view check to bedone or not.[-noDelete] Specify whether to delete (for the destinationdirectory) files not in the source directorybut exist in the destination directory.[-noCheckin] Set means don't check in the files.[-noBranch] Specify to check file out without branching.[-help] Provide the punter with help - ie this blob oftext.NOTES:Option abbreviations are supported as long as enough characters are givento uniquely ID a given option. Eg. -no won't work, but -noCh or -noD will.EOF# we don't want to carry on from here...exit( 0 );} # giveHelp