From:	John W. Krahn	Date:	Tue May 13 06:57:15 2008
Subject:	Re: Log error

Irfan.Sayed@t-systems.com 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);
> @dt2[0]=@dt1[2];
> @dt2[1]=@dt1[1];
> @dt2[2]=@dt1[3];
> @dt2[3]=@dt1[5];
> 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