#!/perl/bin/perl
#----------------------------------------------------------------------#
# Copyright 1998 Cimatron Ltd. #
# #
# Perl name : TDL #
# Programmers : Eli Ofek #
# #
# Description: New SCM System for cimatron - Module promoting tool #
# #
# Invocation: #
# Use: #
# perl tdl -d : #
# To get a list of available Depots(Projects) #
# #
# perl tdl -m <Project> <Configuration> : #
# To get a list of available modules. #
# #
# perl tdl -pm <Project> : #
# To get a list of available PRD corrections. #
# #
# perl tdl -ch <Project> <Configuration> : #
# To check if bruanch exist . #
# #
# perl tdl -l <LabelName> : #
# Lock an existing Label. #
# #
# perl tdl -p <sync?> <lock?> <Project> <Configuration> <Module> <ProdCorrection(optional)>: #
# To promote a specific module & create a Label. #
# #
# <sync?>= -s for synced , -ns for nonsync. #
# <lock?>= -l for locked label, -u for unlocked label. # #
# <Project>= (for example) IT or Elite . #
# <Configuration>= PRE or DEV or INT or QAT or PRD. #
# <Module>= (for example) NC or GEOM .... #
# #
# Notice: * This script creates an error log called: MErrors.log #
# When the file becomes big - you should manualy DELETE it. #
# #
# NOTICE: User must have PCF files in Perforce view ! #
# #
#----------------------------------------------------------------------#
# Modification history: #
# #
# Date Programmer Description #
# #
# 1999/04/20 Eli Ofek New program #
# #
# YY/MM/DD Your name here Short description of changes #
#----------------------------------------------------------------------#
# #
# NOTICE:This application uses a control file which is kept in $CtrlFil#
# Structure of file(For Example): ( PCF) #
# #
# #P/M PRE DEV INT QAT PRD #
# IT 10 10 9 9 9 #
# NC 0 0 0 0 0 #
# GEOM 0 0 0 0 0 #
# SOLID 0 0 0 0 0 #
# DRAFT 0 0 0 0 0 etc. ...more lines of modules. #
#----------------------------------------------------------------------#
# Set general parameters: #
#----------------------------------------------------------------------#
sub GetCfg($,$) # This sub reads values from a cfg file
{ # Input: <Name of file to read from> , <Name of variable to return>
# OutPut: Returns the value of the requested variable read from the file.
my $FileName = shift; # Get file name to read from.
my $VarName = shift; # Get Var name to look for.
my $Value=""; # Holds the returned value.
my $FoundName;
my $FoundVal;
my @AllFile; # Holds the configuration file.
my @Vars; # Holds the configuration file without comments.
my $path;
# Get path To //p4ctrl/pcfs/cfg/
$path=`p4 sync //p4ctrl/pcfs/cfg/... 2>null`;
if ($?!=0) {&ErrorDie("Cannot run : p4 sync //p4ctrl/pcfs/cfg/...2>null . Failed in sub GetCfg.");}
$path=`p4 where //p4ctrl/pcfs/cfg/...`;
if ($?!=0) {&ErrorDie("Cannot run : p4 where //p4ctrl/pcfs/cfg/... . Failed in sub GetCfg.");}
$path=~/\S*\s\S*\s(\S*)\.\.\./;
$path = $1;
my $cmd = join('',"type ",'"',"$path\\$FileName",'"');
@AllFile=`$cmd`; # Read the file
if ($?!=0) {&ErrorDie("Cannot run : $cmd . Failed in sub GetCfg.");}
@Vars = grep ((!/^#/ and !/^\n/),@AllFile); # Eliminate comments.
foreach $Vars (@Vars)
{
# chomp($Vars);
$Vars=~/(\S*)\s*:=\s*(.*)\n/;
$FoundName = $1;
$FoundVal = $2;
if ($FoundName eq $VarName)
{
$Value = $FoundVal;
last;
}
}
if (length($Value)<1) { &ErrorDie("Cannot Find Variable $VarName in file $FileName ! . Failed in sub GetCfg.");}
return $Value;
}
$CtrlFil=""; # Var for Control file path.
$ProtectPath= &GetCfg("nscm.cfg","ProtectPath"); # Var for protect file info.
$timestmp = 0; # Scalars for time stamp.
$sec = 0;
$min = 0;
$hour = 0;
$mday = 0;
$mon = 0;
$year = 0;
$wday = 0;
$yday = 0;
$isdst = 0;
$SCL=""; # Source code-line.(Configuration).
$Module=""; # A var to keep selected module.
$Correction=""; # A var to keep selected prod correction.
$CorrectionN="";# A var to keep Correction in dots format.
$ChangelistNum=""; # A var for changelist number.
@Versions=""; # An array to keep versions of project configuration.
$PREver=0; # Current project PRE version number.
$DEVver=0; # Current project DEV version number.
$INTver=0; # Current project INT version number.
$QATver=0; # Current project QAT version number.
$PRDver=0; # Current project PRD version number.
$NewVer=0; # New version Num.
$SCLver=""; # SCL version.
my $PROJsav="";
@PCFData="";
$i=""; # A simple Counter.
$RestoreProtect=0; # When set in case of Error, tells to restore protect file.
$SyncStat=""; # Flag to sync or not.
$LockStat=""; # Flag to Lock or not.
$DescFile= &GetCfg("nscm.cfg","DescFile");
$TempFile= &GetCfg("nscm.cfg","TempFile"); # Name of temporary file.
$TempFile2= &GetCfg("nscm.cfg","TempFile2"); # Name of temporary file.
@TempArr=""; # A temporary array.
@TempArr2=""; # A temporary array.
$TempVar=""; # A temporary var.
$Depot=""; # A var to keep depot name.
$Depots=""; # A var to keep available depots.
$Modules=""; # A var to keep available modules.
$ProdCorrect=""; # A var to keep available product corrections.
#$ProdCorrectionsOut=""; # A var to keep available product corrections to output.
@ProdCorrections="";
$LabelName=""; # A var to keep Label Name.
$LabelFile= &GetCfg("nscm.cfg","LabelFile"); # A var for filename of label properties.
$ModulePath=""; # Path to module.
$PCFPath=""; # Path to PCF File.
$User=""; # UserName from p4 info
$PROJ=""; # A var for project name.
$PUser=""; # UserName from p4 protect
$PProd=""; # Product from p4 protect
$PSCL=""; # Configuration from p4 protect
# Declaring subroutines #
#----------------------------------------------------------------------#
# Error Subs:
#######################
sub ErrorDie ($) # This Function notifys the user of an Error , create a record of it
{ # In The log file RErrors.log , and exit the script.
close (TMP);
unlink "$TempFile";
my $Msg = shift; # Get message
print "Error !!!\n$Msg !\n" ;
print Err "Perforce Returned:\n" , "$!";
if (open(Err, ">>MErrors.log")!=1) {
print "Error !!!\nCannot create or update Error Log File\n" ;
}
else { select(Err); }
print Err "\nTime of Error: $timestmp \n$Msg !\n ";
print Err "Perforce Returned:\n" , "$!";
print Err "\n----------------------------------------------------------\n";
close(Err);
select(STDOUT);
exit(0);
}
sub ArgError($) # This Function notifys the user of an Argument Error , create a record of it
{ # In The log file RErrors.log , and exit the script.
close (TMP);
unlink "$TempFile";
my $Msg = shift; # Get message
print "\n Error !!!\n Wrong Arguments !!!\n$Msg !\n" ;
if (open(Err, ">>MErrors.log")!=1) {
print "Error !!!\nCannot create or update Error Log File\n" ;
}
else { select(Err); }
print Err "\nTime of Error: $timestmp \n Error !!!\n Wrong Arguments !!!\a\n$Msg !\n ";
print Err "Perforce Returned:\n" , "$!";
print Err "\n----------------------------------------------------------\n";
close(Err);
select(STDOUT);
&Help();
print "\n Please try again.\n\n\n";
exit(0);
}
sub create_change_list() # This subroutine Creates a Changlist and return it's #.
{
if (open(DF,">$DescFile")!=1)
{
&UnLock();
&ErrorDie("Cannot open DescFile $DescFile");
}
else
{ print DF "\nChange: new\n\nClient: \n\nUser: $User\n\nStatus:\n\nDescription:\n Promoting a Version.";
close(DF); }
@TempArr="";
@TempArr=`p4 change -i < $DescFile`;
if ($?!=0) {&UnLock();&ErrorDie("Cannot create $TempFile from p4 change");}
$change_list_number =substr($TempArr[0],7,index($TempArr[0],'cre',0)-8);
unlink "$DescFile";
return $change_list_number;
}
sub Lock # This subroutine Locks Control File to Edit.
{
$PROJ=lc($PROJ);
$ChangelistNum=create_change_list();
# Lock Control File and Check out for edit. In case of failure make a record of it in LOG.
@TempArr=`p4 edit -c $ChangelistNum $CtrlFil`;
if ($?!=0) {&ErrorDie("Cannot checkout Control File $CtrlFil for edit in sub Lock"); }
@TempArr=`p4 lock -c $ChangelistNum $CtrlFil`;
if (($?!=0) || (index($!,"already")!= -1))
{
$RestoreProtect=1;
&ErrorDie("Cannot lock Control File $CtrlFil in sub Lock");
}
# Compute current project versions:
@TempArr="";
# Open PCF file:
# Prepare path to PCF
@Temp=`p4 where //p4ctrl/pcfs/$PROJ/PCF`;
&ErrorDie("Cannot run: p4 where //p4ctrl/pcfs/$PROJ/PCF in sub Lock") if ($?!=0);
$TempVar=substr($Temp[0],rindex($Temp[0],":\\")-1);
chomp($TempVar);
if (open(PCFH,"$TempVar")!=1)
{
&UnLock();
&ErrorDie("Cannot open Contorl File $TempVar in sub Lock");
}
@PCFData=<PCFH>;
close(PCFH); # Spliting versions data into vars.
@Versions=split(/[\ \t\n]+/,$PCFData[1],6); # split on trailing whitespace.
$PREver=$Versions[1];
$DEVver=$Versions[2];
$INTver=$Versions[3];
$QATver=$Versions[4];
$PRDver=$Versions[5];
}
sub UnLock # This subroutine Unlocks & Submit Control File.
{
if ($RestoreProtect!=1) # If there was no error:
{
# Submit Control File to Perforce. In case of failure make a record of it in LOG.
#if (system("p4 unlock -c $ChangelistNum $CtrlFil>$TempFile") || index($!,"locked by")!= -1)
# {
# print "Error !!!\a\nCannot Unlock Control File $CtrlFil !\nYou MUST Unlcok it Manualy !!!\a\n" ;
# if (open(Err, ">>MErrors.log")!=1) {
# print "Error !!!\a\nCannot create or update Error Log File\n" ;
# }
# else { select(Err); }
# print Err "\nTime of Error: $timestmp \nCannot UnLock Control File $CtrlFil !\nYou MUST UnLock it Manualy !!!\n ";
# print Err "Perforce Returned:\n" , "$!";
# print Err "\n----------------------------------------------------------\n";
# close(Err);
# select(STDOUT);
# exit(0);
# }
@TempArr=`p4 submit -c $ChangelistNum`;
if (($?!=0) || (index($!,"unknown")!= -1))
{
&ErrorDie("Cannot Submit Control File $CtrlFil !\nYou MUST Submit it Manualy.\n Failed in sub UnLock");
}
}
}
sub CheckPerm # This Subroutine verifies that the user is permitted
{ # to make a version promotion.
# It returns value of 1 if granted or 0 otherwise.
$value=0; # Value to return from subroutines (Automatically).
my $Kind="";
$PROJ=lc($PROJ);
# Find UserName:
@TempArr="";
@TempArr=`p4 info`;
if ($?!=0)
{
&UnLock();
&ErrorDie("Cannot run p4 info in sub CheckPerm");
}
foreach $TempArr (@TempArr)
{
$User=substr($TempArr,11);
last;
}
$User=substr($User,0,length($User)-1);
# Find Autorized Usernames (Write permissions in Perforce):
$TempVar=$ProtectPath; # Prepare path to Protect file
if (open(TMP,$TempVar)!=1)
{
&UnLock();
&ErrorDie("Cannot open TempFile $TempVar of protect file in sub CheckPerm");
}
while (<TMP>) {
if (index($_,"#")==0){ next; }
if (index($_,"write")!= -1)
{
$PUser=substr($_,7);
$PProd=substr($PUser,index($PUser,"//")+2);
$Kind=substr($PUser,0,index($PUser," "));
$PUser=substr($PUser,index($PUser," ")+1,index($PUser," ",index($PUser," ")+1)-index($PUser," ")-1);
if (index($PProd,"/") ne -1)
{
$PSCL=substr($PProd,index($PProd,"/")+1,3); # Find configuration
$PSCL=uc($PSCL);
$PProd=substr($PProd,0,index($PProd,"/")); # Find project
}
else {$PProd="."};
if ($Kind eq "group")
{
# Find Users In group:
@TempArr=`p4 group -o $PUser`;
if ($?!=0)
{
&UnLock();
&ErrorDie("Cannot run p4 group -o (to find users in group $PUser in sub CheckPerm");
}
$TempVar=join('',@TempArr);
unlink "$TempFile2";
}
$PProd=lc($PProd);
if ( (($User eq $PUser)||($PUser eq "*")||(index($TempVar,"$User")!=-1) ) && ($SCL eq $PSCL) && ( ($PROJ eq $PProd) || ($PProd eq ".") ))
{
close(TMP);
unlink "$TempFile";
$value=1;
last;
}
} # end if
} # end while
if ( $value !=1)
{
close(TMP);
unlink "$TempFile";
$value=0;
}
$value;
}
sub ListModules # Get list of Modules from PCF.
{
$PROJ=lc($PROJ);
# Open PCF file:
# Prepare path to PCF
@Temp=`p4 where //p4ctrl/pcfs/$PROJ/PCF`;
&ErrorDie("Cannot run: p4 where //p4ctrl/pcfs/$PROJ/PCF in sub ListModules") if ($?!=0);
$PCFPath=substr($Temp[0],rindex($Temp[0],":\\")-1);
chomp($PCFPath);
if (open(PCFH,"$PCFPath")!=1)
{
&ErrorDie("Cannot open PCF file $PCFPath in sub ListModules");
}
@TempArr=<PCFH>;
close(PCFH);
foreach $TempArr (@TempArr) # Scan PCF for names of Modules:
{
if (($TempArr=~/#/)||($TempArr=~/$PROJ/i)) { next;}
$TempVar=substr($TempArr,0,index($TempArr," "));
$Modules=join('',$Modules,$TempVar,"\n");
}
#$Modules=substr($Modules,0,length($Modules)-1); # Trunc \n.
}
sub ListProdCorrections # Get list Of Mosules from Protect.
{
$PROJ=lc($PROJ);
my $Sign="/";
my @CurrPrd="";
my $Points='\.\.\.';
# Get current Prd corrections.
my @NewBuffer=`p4 branches`;
if ($?!=0) {&ErrorDie("Cannot create configuration list from p4 branches.\nFailed in sub ListProdCorrections.");}
@TempArr=grep(/Branch $PROJ\wprd/i,@NewBuffer);
foreach $TempArr (@TempArr)
{
$TempArr=~/Branch $PROJ(\w*)(\s)/i;
$TempVar=$1;
$TempVar=~s|_|$Sign|g;
$TempVar=substr($TempVar,1);
push(@CurrPrd,"$TempVar");
}
my @Protections=`type $ProtectPath`;
&ErrorDie("Cannot run: type $ProtectPath in sub ListProdCorrections") if ($?!=0);
foreach $CurrPrd (@CurrPrd) # Show only prd's that has write or open permissions.
{
if (length($CurrPrd)<1) {next;} # Skip spaces.
foreach $Protections (@Protections)
{
if ($Protections=~m@\t(write|open)(.*)//$PROJ/$CurrPrd/$Points@i)
# Path from here^
{
push(@ProdCorrections,"$CurrPrd\n"); # Insert correction to list.
last;
}
}
}
shift(@ProdCorrections); # Tranc space.
}
##### C A N A C E L E D #############################################################
#sub ListProdCorrections # Get list Of Mosules from Protect.
#{
#$PROJ=lc($PROJ);
#
#
## Prepare path to PCF
#
#@Temp=`p4 where //p4ctrl/pcfs/$PROJ/PCF`;
#&ErrorDie("Cannot run: p4 where //p4ctrl/pcfs/$PROJ/PCF in sub ListProdCorrections") if ($?!=0);
#$PCFPath=substr($Temp[0],rindex($Temp[0],":\\")-1);
#chomp($PCFPath);
#
#if (open(PCFH,"$PCFPath")!=1)
# {
# &ErrorDie("Cannot open Control File $PCFPath in sub ListProdCorrections");
# }
#
#
#@PCFData=<PCFH>;
#close(PCFH);
# # Compute current PRD version :
#$i=0;
#foreach $PCFData (@PCFData)
#{
# if (index($PCFData,$PROJ)!=-1) # Find version of project configuration.
# {
# @Versions=split(/[\ \t\n]+/,$PCFData[$i],6); # split on trailing whitespace.
# $SCLver=$Versions[5];
# $SCLver=substr($SCLver,0,length($SCLver)-1);
# }
#$i++;
#}
#
#
#
#
############### Canceled - will be implemented diffrently ##########################
#$TempVar=$ProtectPath; # Prepare path to Protect file
#
# # Transfer Data into both scalars:
#if(open(PReadNew,$TempVar)!=1)
#{
# &ErrorDie("Cannot open $TempVar in sub ListProdCorrections");
# }
#
#@TempArr=<PReadNew>;
#close(PReadNew);
#
# foreach $TempArr (@TempArr )
# {
# if (index($TempArr,"#")==0){ next; } # Check if it's a suiltable correction to user:
# if ((index($TempArr,"write")!= -1) && ((index($TempArr,"$User")!=-1) || (index($TempArr," * * ")!=-1)) && (index($TempArr,"//$PROJ/prd/$SCLver/")!=-1))
# {
# $Correction=substr($TempArr,index($TempArr,"//$PROJ/prd/$SCLver/"),index($TempArr,"...")-index($TempArr,"//$PROJ/prd/$SCLver/")+3); # Keep this correion.
#if (index($ProdCorrections,$Correction)==-1) # Make sure it doesn't appear twice.
# {
# $ProdCorrections=join('',$ProdCorrections,$Correction,"\n");
# $Correction=substr($Correction,0,rindex($Correction,"/"));
# $ProdCorrectionsOut=join('',$ProdCorrectionsOut,$Correction,"\n");
# }
# }
# }
#$ProdCorrections=substr($ProdCorrections,0,length($ProdCorrections)-1); # Trunc \n.
#$Correction="";
#
#######################################################################################
#}
####################################################################################################################
sub Promote # Promote a version using PCF only.
{
################# Permissions check is canceled. ######################################
# if (!&CheckPerm()) # Check write permissions for user.
# {
# &UnLock();
# &ErrorDie("You have no permission for this selection (Failed in sub Promote");
# }
# else
# {
# print "Permission Granted\n";
# }
###########################################################################################
$PROJ=lc($PROJ);
# Open PCF file:
# Prepare path to PCF
@Temp=`p4 where //p4ctrl/pcfs/$PROJ/PCF`;
&ErrorDie("Cannot run: p4 where //p4ctrl/pcfs/$PROJ/PCF in sub Promote") if ($?!=0);
$PCFPath=substr($Temp[0],rindex($Temp[0],":\\")-1);
chomp($PCFPath);
if (open(PCFH,"$PCFPath")!=1)
{
&UnLock();
&ErrorDie("Cannot open Control File $PCFPath in sub Promote");
}
@PCFData=<PCFH>;
close(PCFH);
# Compute current Module version :
$i=0;
foreach $PCFData (@PCFData)
{
if (index($PCFData,$PROJsav)!=-1) # Find version of project configuration.
{
@Versions=split(/[\ \t\n]+/,$PCFData[$i],6); # split on trailing whitespace.
if ($SCL eq 'PRE')
{$SCLver=$Versions[1];}
if ($SCL eq 'DEV')
{$SCLver=$Versions[2];}
elsif ($SCL eq 'INT')
{$SCLver=$Versions[3];}
elsif ($SCL eq 'QAT')
{$SCLver=$Versions[4]; }
elsif ($SCL eq 'PRD')
{$SCLver=$Versions[5];}
}
if (index($PCFData,"$Module ")!=-1) # Find versions of Module.
{
@Versions=split(/[\ \t\n]+/,$PCFData[$i],6); # split on trailing whitespace.
$PREver=$Versions[1];
$DEVver=$Versions[2];
$INTver=$Versions[3];
$QATver=$Versions[4];
$PRDver=$Versions[5];
}
$i++;
}
# Update data in PCF file:
if ($SCL eq 'PRE')
{ $NewVer=$PREver+1;
map {s|$Module(\s)(\s*)(\d*)(?=.*)|$Module$1$2$NewVer|o} @PCFData;}
elsif ($SCL eq 'DEV')
{ $NewVer=$DEVver+1;
map {s|$Module(\s)(\s*)(\d*)(\s*)(\d*)(?=.*)|$Module$1$2$3$4$NewVer|o} @PCFData;}
elsif ($SCL eq 'INT')
{ $NewVer=$INTver+1;
map {s|$Module(\s)(\s*)(\d*)(\s*)(\d*)(\s*)(\d*)(?=.*)|$Module$1$2$3$4$5$6$NewVer|o} @PCFData;}
elsif ($SCL eq 'QAT')
{ $NewVer=$QATver+1;
map {s|$Module(\s)(\s*)(\d*)(\s*)(\d*)(\s*)(\d*)(\s*)(\d*)(?=.*)|$Module$1$2$3$4$5$6$7$8$NewVer|o} @PCFData;}
if (open(PCFH, ">$PCFPath")==0)
{
&UnLock();
&ErrorDie("Cannot create updated Control File $PCFPath !!!\n You MUST restore it Manualy from $CtrlFil.bakn\ Failed in sub Promote");
}
print PCFH @PCFData;
close(PCFH);
&UnLock;
# Create new Label :
$LabelName=join('',$PROJsav,"_",$SCL,"_",$SCLver,"_",$Module,"_",$NewVer,"_","$SyncStat","_","$mday.$mon.$year"); # create Label Name.
# Create LabelFile to avoid openning of editor.
$SCL=lc($SCL);
if (open(LF,">$LabelFile")!=1)
{
&ErrorDie("Cannot open Label File $LabelFile in sub Promote");
}
else
{ if ($PROJsav eq 'Elite')
{
$ModulePath="//$PROJsav/$SCL/$PROJsav/$Module/...";
print LF "Label: $LabelName\nOwner: $User\nDescription: Created by $User\nView:\n\t$ModulePath\n";
close(LF);}
else
{
$ModulePath="//$PROJsav/$SCL/$PROJsav/src/$Module/...";}
print LF "Label: $LabelName\nOwner: $User\nDescription: Created by $User\nView:\n\t$ModulePath\n";
close(LF);}
@TempArr=`p4 label -i <$LabelFile`;
if ($?!=0)
{
&ErrorDie("Cannot create Label Name - Only PCF was updated !\nFailed in sub Promote");
}
else
{
if ($SyncStat eq 's') # If choose to sync first:
{
@TempArr=`p4 sync -f $ModulePath`;
if ($?!=0)
{
&ErrorDie("Cannot sync module $Module to client in sub Promote");
}
}
@TempArr=`p4 labelsync -l $LabelName $ModulePath`;
if ($?!=0)
{
unlink "$LabelFile";
&ErrorDie("Cannot sync to LAbel $LabelName in sub Promote");
}
unlink "$LabelFile";
if ($LockStat eq "locked") { &LockLabel(); } # Lock Label if asked to.
}
# Notify User of Label Name created:
print "Label $LabelName was succesfully created !\n";
}
sub PromoteProd # Promote a version using PCF and Protect.
{
##########################################################
# Permission check is canceled.
###############################################
#if (!&CheckPerm()) # Check write permissions for user.
# {
# &ErrorDie("You have no permission for this selection (Failed in sub PromoteProd");
# }
# else
# {
# print "Permission Granted\n";
# }
################################################################
$PROJ=lc($PROJ);
# Open PCF file:
# Prepare path to PCF
@Temp=`p4 where //p4ctrl/pcfs/$PROJ/PCF`;
&ErrorDie("Cannot run: p4 where //p4ctrl/pcfs/$PROJ/PCF in sub PromoteProd") if ($?!=0);
$PCFPath=substr($Temp[0],rindex($Temp[0],":\\")-1);
chomp($PCFPath);
if (open(PCFH,"$PCFPath")!=1)
{
&ErrorDie("Cannot open Control FIle $PCFPath in sub PromoteProd");
}
@PCFData=<PCFH>;
close(PCFH);
# Compute current Module version :
$i=0;
foreach $PCFData (@PCFData)
{
if (index($PCFData,$PROJsav)!=-1) # Find version of project configuration.
{
@Versions=split(/[\ \t\n]+/,$PCFData[$i],6); # split on trailing whitespace.
if ($SCL eq 'PRE')
{$SCLver=$Versions[1];}
if ($SCL eq 'DEV')
{$SCLver=$Versions[2];}
elsif ($SCL eq 'INT')
{$SCLver=$Versions[3];}
elsif ($SCL eq 'QAT')
{$SCLver=$Versions[4]; }
elsif ($SCL eq 'PRD')
{$SCLver=$Versions[5];}
}
if (index($PCFData,$Module)!=-1) # Find versions of Module.
{
@Versions=split(/[\ \t\n]+/,$PCFData[$i],6); # split on trailing whitespace.
$PREver=$Versions[1];
$DEVver=$Versions[2];
$INTver=$Versions[3];
$QATver=$Versions[4];
$PRDver=$Versions[5];
}
$i++;
}
# Create new Label :
$CorrectionN=$Correction;
$CorrectionN=substr($CorrectionN,0,length(CorrectionN)-3); # Change format.
$CorrectionN=substr($CorrectionN,4,);
$CorrectionN=~s|/|.|g;
$LabelName=join('',$PROJsav,"_",$SCL,"_",$CorrectionN,"_",$Module,"_","$SyncStat","_","$mday.$mon.$year"); # create Label Name.
# Create LabelFile to avoid openning of editor.
$SCL=lc($SCL);
if (open(LF,">$LabelFile")!=1)
{
&ErrorDie("Cannot Label File $LabelFile in sub PromoteProd");
}
else
{
$Correction=substr($Correction,0,length($Correction)-3);
if ($PROJsav eq 'Elite')
{ print LF "Label: $LabelName\nOwner: $User\nDescription: Created by $User\nView:\n$ModulePath\n";
$ModulePath="//$PROJsav/$SCL/$PROJsav/$Module/...";}
else
{print LF "Label: $LabelName\nOwner: $User\nDescription: Created by $User\nView:\n$ModulePath\n";
$ModulePath="//$PROJsav/$SCL/$PROJsav/src/$Module/...";}
close(LF);}
@TempArr=`p4 label -i <$LabelFile`;
if ($?!=0)
{
&ErrorDie("Cannot create Label File - Only PCF was updated.\nFailed in sub PromoteProd");
}
if ($SyncStat eq 's') # If choose to sync first:
{
@TempArr=`p4 sync -f $ModulePath`;
if ($?!=0)
{
&ErrorDie("Cannot sync module $Module to client in sub PromoteProd");
}
}
@TempArr=`p4 labelsync -l $LabelName $ModulePath`;
if ($?!=0)
{
unlink "$LabelFile";
&ErrorDie("Cannot sync to Label $LabelName in sub PromoteProd");
}
unlink "$LabelFile";
if ($LockStat eq "locked") { &LockLabel(); } # Lock Label if asked to.
# Notify User of Label Name created:
print "Label $LabelName was succesfully created !\n";
}
sub FindDepots
{
# Find available Depots from cliect view.
@TempArr=`p4 client -o`;
if ($?!=0) { &ErrorDie("Cannot create Depots TempFile $TempFile in sub FindDepots");}
foreach $TempArr (@TempArr)
{
if (index($TempArr,'//')!=-1) # canceled: &&((index($_,'DEV')!=-1)||(index($_,'dev')!=-1)))
{
$TempVar=substr($TempArr,3,index($TempArr,'/',3)-3);
# Iliminate Depots that are not Projects:
if ((index($TempVar,'Demo')==-1) && (index($TempVar,'SoftInfra')==-1) && (index($TempVar,'Spatial')==-1)&& (index($TempVar,'p4ctrl')==-1))
{
if (index($DepotsOutput,$TempVar)==-1) # Make sure there is no repetition.
{
$DepotsOutput=join('',$DepotsOutput,$TempVar,"\n");
}
}
}
}
$Depots=join('',$DepotsOutput,"\n");
#$DepotsOutput=substr($DepotsOutput,0,length($DepotsOutput)-1); # Trunc last \n.
}
# This CANCELED sub find the depots from p4 depots and not from client view.
#sub FindDepots
#{
# # Find available Depots.
#
#system("p4 depots >$TempFile") && die "Error !!!\a\nCannot create $TempFile\n" ;
#open(TMP,"$TempFile") || die "Error !!!\a\nCannot open $TempFile : $!\n" ;
#while (<TMP>)
#{
#$TempVar=substr($_,6,index($_,' ',7)-6);
# # Iliminate Depots that are not Projects:
#if ((index($TempVar,'Demo')==-1) && (index($TempVar,'SoftInfra')==-1) && (index($TempVar,'Spatial')==-1))
#{
#$DepotsOutput=join('',$DepotsOutput,$TempVar,"\n");
#}
# }
#$Depots=join('',$DepotsOutput,"\n");
#close(TMP);
#unlink($TempFile);
##$DepotsOutput=substr($DepotsOutput,0,length($DepotsOutput)-1); # Trunc last \n.
#}
sub LockLabel # A sub that locks a Label.
{
# Find UserName:
@TempArr=`p4 info`;
if ($?!=0) {die "Error !!!\a\nCannot run p4 info\n" ;}
foreach $TempArr (@TempArr)
{
$User=substr($TempArr,11);
last;
}
$User=substr($User,0,length($User)-1);
# Find View:
@TempArr2=`p4 label -o $LabelName`;
if ($?!=0) { die "Error !!!\a\nCannot run p4 label -o $LabelName\n" ;}
@TempArr="";
$TempVar=0;
$i=0;
foreach $TempArr2 (@TempArr2)
{
if ($i==1)
{
$TempArr[$TempVar]=$TempArr2;
$TempVar=$TempVar+1;
}
if (index($TempArr2,"View:\n")!=-1)
{$i=1;}
}
# Create LabelFile to avoid openning of editor.
if (open(LF,">$LabelFile")!=1)
{
&ErrorDie("Cannot open Label File $LabelFile in sub LockLabel");
}
else
{ if ($PROJ eq 'Elite')
{
print LF "Label: $LabelName\nOwner: $User\nDescription: Created by $User\nOptions: $LockStat\nView:\n@TempArr\n";
}
else
{print LF "Label: $LabelName\nOwner: $User\nDescription: Created by $User\nOptions: $LockStat\nView:\n@TempArr\n";
}
close(LF);}
if (system("p4 label -i <$LabelFile>$TempFile")!=0)
{
&ErrorDie("Cannot update Label $LabelName in sub LockLabel");
}
unlink "$LabelFile";
unlink "$TempFile";
}
sub SyncToLabel($) #This sub Sync to a label without removing other files from the client.
{
my $SyncLabel=shift; # Get label name.
my @BufFiles="";
my @Files="";
my $Command=join('',"p4 files @","$SyncLabel");
@BufFiles=`$Command`; # Get files to sync from label.
if ($?!=0)
{
&ErrorDie("Cannot list Label $SyncLabel files in sub SyncToLabel");
}
# Get only file names:
foreach $BufFiles (@BufFiles)
{
$TempVar=join("",substr($BufFiles,0,index($BufFiles," ")),"\n");
push(@Files,$TempVar);
}
# Put List of filenames into a file:
if (open(FL,">Files.dat")!=1)
{
&ErrorDie("Cannot open file list File Files.dat in sub SyncToLabel");
}
print FL @Files; # Put File List in File
close(FL);
@TempArr=`p4 -x Files.dat sync`; # Sync to list from File.
if ($?!=0)
{
unlink "Files.dat";
&ErrorDie("Cannot Sync to list of files from Files.dat in sub SyncToLabel");
}
unlink "Files.dat";
}
sub CheckPCF($) # This sub check if the PCF file of given project is checked out.
{
my $Project=shift;
@TempArr=`p4 opened -a`;
if ($?!=0) {die "Error !!!\a\nCannot run p4 opened -a\n" ;}
foreach $TempArr (@TempArr)
{
if ((index($TempArr,"/PCF#")!=-1)&&(index($TempArr,"$Project")!=-1))
{
/(\w*)by (\w*)@(\w*)/;
$TempVar=$2;
print "NOTE !!!\nApplication Control File (PCF) of Project:$Project is currently checked out by: $TempVar.\n You must wait until $TempVar submits it first, then try again.\n" ;
exit(0);
}
}
}
sub CheckBranch($,$) # This Subroutine verifies that a specified branch exist.
{
# It returns value of 1 if exist or 0 otherwise.
$value=0; # Value to return from subroutines (Automatically).
$projs=shift; # get project to search.
$conf=shift; # get conf to search.
$confver="";
$str=join('',$projs,"_",$conf);
$PROJ=lc($PROJ);
# find current conf version:
# Open PCF file:
# Prepare path to PCF
@Temp=`p4 where //p4ctrl/pcfs/$PROJ/PCF`;
&ErrorDie("Cannot run: p4 where //p4ctrl/pcfs/$PROJ/PCF in sub CheckBranch") if ($?!=0);
$TempVar=substr($Temp[0],rindex($Temp[0],":\\")-1);
chomp($TempVar);
if (open(PCFH,"$TempVar")!=1)
{
&ErrorDie("Cannot open Contorl File $TempVar in sub CheckBranch");
}
@PCFData=<PCFH>;
close(PCFH); # Spliting versions data into vars.
@Versions=split(/[\ \t\n]+/,$PCFData[1],6); # split on trailing whitespace.
if ($conf eq 'PRE')
{$confver=$Versions[1]; }
if ($conf eq 'DEV')
{$confver=$Versions[2]; }
if ($conf eq 'INT')
{$confver=$Versions[3]; }
if ($conf eq 'QAT')
{$confver=$Versions[4]; }
if ($conf eq 'PRD')
{$confver=$Versions[5]; }
# Check if branch is in list:
@TempArr=`p4 branches`;
if ($?!=0)
{ &ErrorDie("Cannot run p4 branches"); }
if ($conf eq 'pre')
{ $value=grep(/$str/,@TempArr);}
else {
$str=join('',$str,"_",$confver);
$value=grep(/$str/,@TempArr);
}
if ($conf eq 'dev') {$value=1;}; # DEV always exist.
$value;
}
sub Help
{
print "\n\n Invocation: \n\n";
print " Use: \n";
print " perl tdl -d : \n";
print " To get a list of available Depots(Projects) \n";
print " \n";
print " perl tdl -m <Project> <Configuration> : \n";
print " To get a list of available modules. \n";
print " \n";
print " perl tdl -pm <Project> : \n";
print " To get a list of available prod corrctions. \n";
print " \n";
print " perl tdl -ch <Project> <Configuration> : \n";
print " To check if bruanch exist . \n";
print " \n";
print " perl tdl -l <LabelName> : \n";
print " Lock an existing Label. \n";
print " \n";
print " perl tdl -s <LabelName> : \n";
print " Sync to a label witout removing other files from client. \n";
print " \n";
print " perl tdl -p <sync?> <lock?> <Project> <Configuration> <Module> <ProdCorrection(optional)>:\n";
print " To promote a specific module & create a Label. \n";
print " \n";
print " <sync?>= -s for synced , -ns for nonsync. \n";
print " <lock?>= -l for locked label, -u for unlocked label. \n";
print " <Project>= (for example) IT or Elite . \n";
print " <Configuration>= PRE or DEV or INT or QAT or PRD. \n";
print " <Module>= (for example) NC or GEOM .... \n";
print " \n";
print " NOTICE: User must have PCF files in Perforce view ! \n\n\n";
}
# Begin Version promotion procedure: #
#----------------------------------------------------------------------#
# Print help in case of an "help"-like argument.
if (($ARGV[0] eq 'help') || ($ARGV[0] eq 'HELP') || ($ARGV[0] eq '?')
|| ($ARGV[0] eq '-?') || ($ARGV[0] eq '\?') || ($ARGV[0] eq '-h'))
{
&Help();
exit(0);
}
# Create timestamp:
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$mon++;
if ($mday<10) { $mday="0$mday";}
if ($mon<10) { $mon="0$mon";}
$year=$year+1900;
$timestmp = (join ".", "",$year, $mon, $mday, $hour, $min, $sec);
$TempFile="Tmp.$$"; # Create uniq tempfile to avoid colision.
$TempFile2="Tmp2.$$"; # Create uniq tempfile to avoid colision.
# Check to see if P4 is in path:
@TempArr=`p4 info`;
if ($?!=0) { die "Error !!!\a\nCannot create $TempFile\n" ;}
if (index($TempArr[0],"The name specified is not recognized")!=-1)
{
&ErrorDie("Cannot Find p4 in your PATH !\n failed in main");
}
# Sync all PCF files to head revision on client:
@TempArr=`p4 sync -f //p4ctrl/pcfs/... `;
if ($?!=0)
{
&ErrorDie("Cannot sync $Depot PCF file to client in main");
}
# Check the arguments given in STDIN, then choose action.
if ($ARGV[0] eq '-d') # If asked to print a list of Depots.
{ &FindDepots();
print "$DepotsOutput";
exit(0); }
elsif ($ARGV[0] eq '-m') # If asked to print a list of Modules.
{
&FindDepots();
if (index($Depots,"$ARGV[1]\n")!=-1)
{
$PROJ=$ARGV[1]; $CtrlFil=join('','//p4ctrl/pcfs/',$PROJ,'/PCF');
if (($ARGV[2] eq 'PRE') || ($ARGV[2] eq 'DEV') || ($ARGV[2] eq 'INT') || ($ARGV[2] eq 'QAT') || ($ARGV[2] eq 'PRD'))
{ $SCL=$ARGV[2];
&ListModules();
print "$Modules";
exit(0); }
else {
&ArgError("Wrong configuration parameter");
}
}
else {
&ArgError("Wrong project parameter");
}
}
elsif ($ARGV[0] eq '-ch') # If asked to Check if Branch exist.
{
&FindDepots();
if (index($Depots,"$ARGV[1]\n")!=-1)
{
$PROJ=$ARGV[1]; $CtrlFil=join('','//p4ctrl/pcfs/',$PROJ,'/PCF');
if (($ARGV[2] eq 'PRE') || ($ARGV[2] eq 'DEV') || ($ARGV[2] eq 'INT') || ($ARGV[2] eq 'QAT') || ($ARGV[2] eq 'PRD'))
{ $SCL=$ARGV[2];
# if (!&CheckPerm()) # Permissions check canceled.
# {exit(2);}
# else
# {
if (!&CheckBranch(lc($PROJ),lc($SCL)))
{exit(2);}
else
{exit(1);}
# }
}
else {
&ArgError("Wrong configuration parameter");
}
}
else {
&ArgError("Wrong project parameter");
}
}
elsif ($ARGV[0] eq '-pm') # If asked to print a list of Prod corrections.
{
&FindDepots();
if (index($Depots,"$ARGV[1]\n")!=-1)
{
$PROJ=$ARGV[1]; $CtrlFil=join('','//p4ctrl/pcfs/',$PROJ,'/PCF');
$SCL='PRD';
&ListProdCorrections();
# print "$ProdCorrectionsOut";
$ProdCorrections[0]=" $ProdCorrections[0]";
print "@ProdCorrections";
exit(0);
}
else {
&ArgError("Wrong project parameter");
}
}
elsif ($ARGV[0] eq '-l') # If asked to Lock a Label.
{
$LabelName=$ARGV[1];
$LockStat="locked";
&LockLabel();
print "Label $LabelName is now Locked !!!\n";
exit(0);
}
elsif ($ARGV[0] eq '-s') # If asked to Sync to a Label.
{
$LabelName=$ARGV[1];
&SyncToLabel($LabelName);
print "Client was succesfully Synced to Label: $LabelName !!!\n";
exit(0);
}
elsif ($ARGV[0] eq '-p') # If asked to promote a specific Module.
{
if ($ARGV[1] eq '-s') { $SyncStat='s';} # Check if asked to sync or not.
elsif ($ARGV[1] eq '-ns') { $SyncStat='ns';}
else {
&ArgError("Wrong sync parameter");
}
if ($ARGV[2] eq '-l') { $LockStat='locked';} # Check if asked to sync or not.
elsif ($ARGV[2] eq '-u') { $LockStat='unlocked';}
else {
&ArgError("Wrong lock parameter");
}
&FindDepots();
if (index($Depots,"$ARGV[3]\n")!=-1)
{
$PROJ=$ARGV[3]; $CtrlFil=join('','//p4ctrl/pcfs/',$PROJ,'/PCF');
$PROJsav=$PROJ;
&CheckPCF("$PROJ");
&Lock();
if (($ARGV[4] eq 'PRE') || ($ARGV[4] eq 'DEV') || ($ARGV[4] eq 'INT') || ($ARGV[4] eq 'QAT'))
{ $SCL=$ARGV[4];
&ListModules();
if (index($Modules,"$ARGV[5]\n")!=-1)
{ $Module=$ARGV[5];
&Promote();
exit(0);
}
else {
&UnLock();
&ArgError("Wrong module parameter");
}
}
elsif ($ARGV[4] eq 'PRD') # If asked to label a PRD correction.
{
&UnLock();
$SCL=$ARGV[4];
&ListProdCorrections();
&ListModules();
if (index($Modules,"$ARGV[5]\n")!=-1)
{ $Module=$ARGV[5];
$ProdCorrect=join("\n","\n",@ProdCorrections,"\n");
if (index($ProdCorrect,"\n$ARGV[6]\n")!=-1)
{ $Correction=$ARGV[6];
&CheckPCF("$PROJ");
&PromoteProd();
exit(0);
}
else
{
&ArgError("Wrong correction parameter");
}
}
else
{
&ArgError("Wrong module parameter");
}
}
else
{
&ArgError("Wrong configuration parameter");
}
}
else
{
&ArgError("Wrong project parameter");
}
}
else {
&ArgError("Wrong Primary parameter(switch)");
}