[EMAIL PROTECTED] wrote:
Hi All,
Hello,
#! /usr/tools/deployment/bin/perl
use warnings;
use strict;
use lib "/home/m.belgaonkar/";
use lib "/home/p.gupta/";
$i=0;
$p=0;
$l=0;
my $i = 0;
my $p = 0;
my $l = 0;
$dt=qx(date);
@dt1=split(' ',$dt);
@[EMAIL PROTECTED];
@[EMAIL PROTECTED];
@[EMAIL PROTECTED];
@[EMAIL PROTECTED];
chomp($dt_fin=join(":",@dt2));
use POSIX 'strftime';
my $dt_fin = strftime '%d:%b:%H:%M:%S:%Y', localtime;
system ("clear");
0 == system 'clear' or warn "system 'clear' failed: $?";
print "$dt_fin\n";
print "****************************************************\n";
print "******************Merge Tool************************\n";
$ap_nm=`pwd`;
use Cwd;
my $ap_nm = cwd;
if ($ap_nm =~ /view/){print "You are in the view:$ap_nm\n";}else{print "You are not
in any clearcase view \n"; exit 1;}
if ($ap_nm =~ /oms/)
{
$ap_nm=oms;
$ap_nm = 'oms';
print "Application name:oms\n";
}
elsif ($ap_nm =~ /akb/)
{
$ap_nm=akb;
$ap_nm = 'akb';
print "Application name:akb\n";
}
[ SNIP more of the same ($DIETY knows why this is repeated!) ]
else
{
print "You does not seems to be in any application\n";
print "Exiting\n";
exit 1;
}
config_spec_chk();
env();
sub config_spec_chk()
sub config_spec_chk
{
%hash = (
oms => 'oms.rel.02.23.000',
akb => 'akb.rel.01.00.000',
cia => 'ci1.rel.02.00.000',
crm => 'crm.rel.03.00.000',
dps => 'dps.rel.01.00.000',
hmy => 'hmy.rel.00.00.000',
vss => 'vss.int.00.00.000',
prs => 'prs.rel.01.09.000',
ccb => 'ccb.rel.01.02.000',
wsp => 'wsp.rel.00.00.000',
);
%hash_const = (
"element /vob/support/tools/deployment/repository" => '/main/LATEST',
"element /vob/lib/repository/..." => '/main/LATEST',
"element /vob/lib/rep_v1/..." => '/main/LATEST',
"element /vob/support/tools/deployment/packages/..." => '/main/LATEST',
"element /vob/lib/packages/..." => '/main/LATEST',
"element /vob/support/tools/deployment/specs/..." => 'CHECKEDOUT',
"element /vob/support/tools/deployment/specs/..." => '/main/LATEST',
"element /vob/support/tools/deployment/initfiles/..." => 'CHECKEDOUT',
"element /vob/support/tools/deployment/initfiles/..." => '/main/LATEST',
"element /vob/support/tools/deployment/relnotespecs/..." =>
'CHECKEDOUT',
"element /vob/support/tools/deployment/relnotespecs/..." =>
'/main/LATEST',
"element /vob/support/tools/deployment/mergespecs/..." => 'CHECKEDOUT',
"element /vob/support/tools/deployment/mergespecs/..." =>
'/main/LATEST',
"element /vob/support/tools/deployment/scripts/..." => '/main/LATEST',
"element /vob/support/tools/deployment/global_env_files/..." =>
'/main/LATEST',
"element -directory /vob/support/tools/deployment" => '/main/LATEST',
"element -directory /vob/support/tools" => '/main/LATEST',
"element -directory /vob/support" => '/main/LATEST',
"element -directory /vob/lib" => '/main/LATEST',
);
#qx(ct catcs | tee /home/m.belgaonkar/curr_conf_spec_$dt_fin);
open(fh, ">/tmp/config") || die "Can't open file:\n";
You should include the $! variable in the error message so you know
*why* it failed to open.
while (($key,$value)=each(%hash))
{
if (($key eq oms) && ($ap_nm =~ /oms/))
if ( $key eq 'oms' && $ap_nm =~ /oms/ )
{
$rel_br=$value;
print fh "element /vob/support/tools/deployment/specs/... CHECKEDOUT\n";
print fh "element /vob/support/tools/deployment/initfiles/... CHECKEDOUT\n";
print fh "element /vob/support/tools/deployment/relnotespecs/...
CHECKEDOUT\n";
print fh "element /vob/support/tools/deployment/mergespecs/...
CHECKEDOUT\n";
print fh "\n";
foreach (keys %hash_const)
{
print fh "$_ $hash_const{$_}\n";
}
print fh "\n";
print fh "element * CHECKEDOUT\n";
print fh "element * .../$value/LATEST\n";
print fh "element * /main/0 -mkbranch $value\n";
}
Why are you repeating this *exact* *same* code block *ten* times?
[ SNIP more of the exact same code ]
else{}
}
if ($?=0){print "Config spec generation failed\n";exit 1;}
else{print "Config spec of the destination view is being created\n"; print "Config
spec :Done\n";}
close (fh);
print "Setting the destination config spec to the current view\n";
`/usr/atria/bin/cleartool setcs /tmp/config`;
perldoc -q "What.s wrong with using backticks in a void context"
if ($?){print "Config spec not set correctly\n check the same and try once
again\n"; exit 1;}
else{print "Config spec set correctly\n";}
# print "Reexecuting the config spec \n";
# `usr/atria/bin/cleartool setcs -current`;
# if ($?){print "Execution of config spec failed\n check the same and try once
again\n"; exit 1;}
# else{print "Done\n";}
}
sub env()
sub env
{
print "Enter the baseline:";
chomp($bl = <STDIN>);
chomp($rel_lbl_fin=$bl);
print "Enter the update:";
chomp($up_bl = <STDIN>);
print "Enter the no. of packages needs to be merged:";
chomp($ct_pkg = <STDIN>);
for ($i=1;$i<=$ct_pkg;$i++)
for my $i ( 1 .. $ct_pkg )
{
print "Enter the release note for package $i :";
chomp($pk = <STDIN>);
print "Enter the update:";
chomp($up = <STDIN>);
print "Enter the development branch name for package $i :";
chomp($br_name_fin = <STDIN>);
$dev_lbl=$pk;
# $br_name=$dev_lbl;
# $br_name_fin=lc $br_name;
if ($up != 0){
chomp($depl_lbl="D." . "$pk" . ".$up");
Why are you chomp()ing $up a second time?
}else{chomp($depl_lbl="D." . $pk);}
Why are you chomp()ing $pk a second time?
`/usr/atria/bin/cleartool lstype lbtype:$depl_lbl 2>/dev/null`;
perldoc -q "What.s wrong with using backticks in a void context"
if ($?)
{
print"Depl. Label $depl_lbl is not exist\n";
print "Creating the deployment label and applying it to all files which has
development label\n";
`/usr/atria/bin/cleartool mklbtype -nc $depl_lbl`;
perldoc -q "What.s wrong with using backticks in a void context"
if ($?){print "Deployment label creation failed. Please check and try once
again\n"; exit 1;}
else{
print "Deployment label created successfully\n";
}
}
else{
print "Deployment label for this package would be : $depl_lbl\n";}
#if ($pk =~ /(.*)\./) {
# print "$1\n";
# $dev_lbl=$1;
#}
`/usr/atria/bin/cleartool lstype lbtype:$dev_lbl 2>/dev/null`;
perldoc -q "What.s wrong with using backticks in a void context"
if ($?)
{
print"Dev. Label $dev_lbl is not exist\n";
print "Create the devlopment label,apply it to all files and directories and then
start merge\n";
exit 1;}
else{
print "Devlopment label for this package would be : $dev_lbl\n";}
`/usr/atria/bin/cleartool lstype brtype:$br_name_fin 2>/dev/null`;
perldoc -q "What.s wrong with using backticks in a void context"
if ($?){ print "Dev. branch $br_name_fin is not exist\n"; exit 1;}
else{print "Dev. branch is $br_name_fin\n";}
compare();
push (@pkg_lst,$pk);
}
rel_label();
}
sub compare()
sub compare
{
print "Compairing files with development label and deployment label\n";
chomp($ct_fil_depl=`/usr/atria/bin/cleartool find -all -version "lbtype($depl_lbl)
&& brtype($br_name_fin)" -print | wc -l`);
chomp($ct_fil_dev=`/usr/atria/bin/cleartool find -all -version "lbtype($dev_lbl)
&& brtype($br_name_fin)" -print | wc -l`);
chomp(@no_depl_lbl=`/usr/atria/bin/cleartool find -all -version "lbtype($dev_lbl) &&
brtype($br_name_fin) &&! lbtype($depl_lbl)" -print`);
print " No. of files which has deployment label : $ct_fil_depl\n";
print " No. of files which has development label : $ct_fil_dev\n";
print "@no_depl_lbl\n";
if (@no_depl_lbl eq "" || @no_depl_lbl eq "NULL" || !defined @no_depl_lbl)
@no_depl_lbl will *NEVER* be equal to "" or "NULL", *NEVER*! defined()
should not be used on arrays or hashes.
perldoc -q "Why does defined.. return true on empty arrays and hashes"
{
print "All the files have both deployment label $depl_lbl and development label
$dev_lbl\n";
merge();
}
else
{
print "Files with deployment $depl_lbl and development label $dev_lbl are
mismatch\n";
print "Applying the deployment label to all versions which has developer
label\n";
print "Checking the lock status of deployment label\n";
$st_chk= `/usr/atria/bin/cleartool lslock lbtype:$depl_lbl`;
if($st_chk eq "")
{
print " Label is not locked\n";
}
else
{
print "Label is locked\n Unlocking the label\n";
`/usr/atria/bin/cleartool unlock lbtype:$depl_lbl`;
if($?){print "Label unlocking failed\n Check the same and try once
again\n";exit 1;}
else{print "Label unlocked successfully\n";}}
$a=0;
foreach(@no_depl_lbl)
{
`/usr/atria/bin/cleartool mklabel -replace $depl_lbl $_`;
perldoc -q "What.s wrong with using backticks in a void context"
if ($?){print"Unable to apply the label $depl_lbl to file $_.Please chk the same
and try again\n";exit 1;}
else{$a++;}
}
}
if($a!=0){print "Deployment label has been applied to all files now\n";
print "Locking the deployment label\n";
`/usr/atria/bin/cleartool lock lbtype:$depl_lbl`;
perldoc -q "What.s wrong with using backticks in a void context"
if($?){print "Locking of deployment label failed\n Please check the same and try
again\n";}
else{print "Label locked successfully\n";}
merge();
}
}
sub merge()
sub merge
{
print "Merge operation from developer branch $br_name_fin to the release branch
$rel_br\n";
@merg_prev=`/usr/atria/bin/cleartool findmerge -all -element
"brtype($br_name_fin)" -fversion $depl_lbl -print -short`;
chomp($size = @merg_prev);
if ($size==0){ print "All the files on the development branch and release branch
are identical.\n No need to merge anything\n";}
else
{
print "Following files will be merged \n";
print "@merg_prev\n\n";
print "Confirm [y/n]:";
chomp($conf = <STDIN>);
if (($conf eq "y") || ($conf eq "Y"))
if ( uc $conf eq 'Y' )
{
@merg_act=`/usr/atria/bin/cleartool findmerge -all -element
"brtype($br_name_fin)" -fversion $depl_lbl -merge -log /tmp/merge_log_$dt_fin`;
if($?){print "Merge operation failed....\n Check the same and try once
again\n"; exit 1;}
else {
print "Merged all the files to the release branch\n";
print "Checking in all files and directoris\n";
`/usr/atria/bin/cleartool lsco -r -cview -s . | xargs ct ci -nc`;
perldoc -q "What.s wrong with using backticks in a void context"
if($?){ print "Check in operation failed.....\n please check the same and try
again\n"; exit 1;}else{}
@lsco=`/usr/atria/bin/cleartool lsco -r -cview -s .`;
if(@lsco eq "" || !defined @lsco)
@lsco will *NEVER* be equal to "", *NEVER*! defined() should not be
used on arrays or hashes.
perldoc -q "Why does defined.. return true on empty arrays and hashes"
{
print "All the files checked in properly\n";
print "Merge operation completed for package $pk with update $up\n";
log();
}else{ print "Some files are still in checked out condition\n check the same and try
again\n"; exit 1;}
mail();}
}
elsif(($conf eq "n") || ($conf eq "N"))
elsif ( uc $conf eq 'N' )
{
print "OK!!!!!\n";
exit 1;
}
else
{
print "Bad choice\n";
exit 1;
}
}
}
sub rel_label()
sub rel_label
{
print "Checking the REL label \n";
`/usr/atria/bin/cleartool lstype lbtype:$rel_lbl_fin 2>/dev/null`;
perldoc -q "What.s wrong with using backticks in a void context"
if($?){ print "REL label does not exist\n Creating the REL label ....\n";
`/usr/atria/bin/cleartool mklbtype -nc $rel_lbl_fin`;
perldoc -q "What.s wrong with using backticks in a void context"
if($?){ print "REL label creation failed\n Please check the same and try again\n
"; exit 1;}
else{ print "REL label created successfully\n";}
}
else
{
print "Checking the lock status of REL label \n";
$st=`/usr/atria/bin/cleartool lslock lbtype:$rel_lbl_fin`;
if ($st eq "")
{
print "Label is not locked\n";
}
else
{
print "Label is locked\n Unlocking the label\n";
`/usr/atria/bin/cleartool unlock lbtype:$rel_lbl_fin`;
perldoc -q "What.s wrong with using backticks in a void context"
if($?){print "Label unlocking failed\n Check the same and try once
again\n";exit 1;}
else{print "Label unlocked successfully\n";}
}}
print "Applying the REL label to all files and directory\n";
`/usr/atria/bin/cleartool mklabel -rec -replace $rel_lbl_fin .`;
perldoc -q "What.s wrong with using backticks in a void context"
if($?){ print "REL label application to all files has been failed\n Please check
the same and try again\n"; exit 1;}
else{print "REL label has been applied properly to all files\n";
print "Locking the REL label\n";
`/usr/atria/bin/cleartool lock lbtype:$rel_lbl_fin`;
perldoc -q "What.s wrong with using backticks in a void context"
if($?){ print "Locking of REL label failed\n Please check the same and try
again\n";}
else{ print " REL label locked successfully\n";}
}
}
sub log()
This will clash with Perl's built-in log() function.
perldoc -f log
{
# this function will create the detail log file for each package merged to the
release branch.
open(fh1, ">/tmp/Log_Merge_$pk_$up") || die "Cant open file $!\n";
print fh1 "**************************************************************\n";
print fh1 "Merge log file for package $pk update $up\n";
print fh1 "REL baseline : $bl update : $up_bl\n";
print fh1 "Package release note : $pk update : $up\n";
print fh1 "No. of files with development label : $ct_fil_dev\n";
print fh1 "Pathname of each file is \n";
print fh1 "No. of files with deployment label : $ct_fil_depl\n";
print fh1 "Pathname of each file is \n";
print fh1 "No. of files which needs to be merged : \n";
print fh1 "Following files got merged\n";
print fh1 "@merg_prev\n\n";
}
sub mail()
sub mail
[ SNIP ]
John
--
Perl isn't a toolbox, but a small machine shop where you
can special-order certain sorts of tools at low cost and
in short order. -- Larry Wall
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
