defaria.com/Computers/code/bin/cmplab

   1 #!/usr/bin/perl
   2 ################################################################################
   3 #
   4 # File:         cmplab
   5 # Description:  This script will produce listing of the delta between two
   6 #               different labels
   7 # Author:       Andrew@DeFaria.com
   8 # Created:      Thu May 23 13:41:05  2002
   9 # Modified:
  10 # Language:     Perl
  11 #
  12 # (c) Copyright 2002, Salira Optical Network Systems, all rights reserved.
  13 #
  14 ################################################################################
  15 $me = substr ($0, rindex ($0, "/") + 1);
  16
  17 # The view and vob to perform the work in.
  18 $view='\\\\sons-clearcase\views\official';
  19 $vob="$view\\salira";
  20
  21 sub usage {
  22   print "Usage: $me: [-g] <label 1> <label 2>\n";
  23   print "\nWhere:\n";
  24   print "\n\t-g\t\tGenerate lists - otherwise <label 1>.list and\n";
  25   print "\t\t\t<label 2>.list files in the current directory are\n";
  26   print "\t\t\tsearched. If the file is not found then a list file\n";
  27   print "\t\t\tis generated.\n";
  28   print "\t<label 1>\tClearcase label to compare from\n";
  29   print "\t<label 2>\tClearcase label to compare to\n";
  30   exit 1;
  31 } # usage
  32
  33 sub ProduceListFile {
  34   # This subroutine will simply produce a file listing all Clearcase elements
  35   # elements into a file.
  36   my ($label) = shift;
  37
  38   # Produce listing into array
  39   print "Producing a list of elements labeled $label...\n";
  40   `cleartool find -all -version "lbtype($label)" -print > $cwd/$label.list`;
  41 } # ProduceListFile
  42
  43 sub PrintArray {
  44   # This subroutine merely prints the array passed to it.
  45   foreach (@_) {
  46     print "$_\n";
  47   } # foreach
  48 } # PrintArray
  49
  50 sub CheckLabel {
  51   # This subroutine checks to see if the label passed is a Clearcase label.
  52   my ($label) = shift;
  53
  54   return system ("cleartool lstype lbtype:$label > /dev/null 2>&1");
  55 } # CheckLabel
  56
  57 sub ProduceLists {
  58   # This subrourtine produces a list of all files labeled by each label. This
  59   # lists are placed into arrays and saved as files for future runs.
  60   if ($dynamic eq 1) {
  61     ProduceListFile ($lab1);
  62     ProduceListFile ($lab2);
  63   } else {
  64     if (! -f "$cwd/$lab1.list") {
  65       ProduceListFile ($lab1);
  66     } # if
  67     if (! -f "$cwd/$lab2.list") {
  68       ProduceListFile ($lab2);
  69     } # if
  70   } # if
  71
  72   # Load up arrays from listing files
  73   open (LAB1OUT, "<$cwd/$lab1.list") || die "Unable to open $cwd/$lab1.list\n";
  74   @lab1out = <LAB1OUT>;
  75
  76   open (LAB2OUT, "<$cwd/$lab2.list") || die "Unable to open $cwd/$lab2.list\n";
  77   @lab2out = <LAB2OUT>;
  78
  79   # Now ensure their in sorted order
  80   @lab1out = sort (@lab1out);
  81   @lab2out = sort (@lab2out);
  82 } # ProduceLists
  83
  84 sub ProcessLists {
  85   # This subroutine will process the two list arrays producing the report.
  86   # Now enter a loop comparing items
  87   $lab1line = shift (@lab1out);
  88   $lab2line = shift (@lab2out);
  89
  90   if (!$lab1line && !$lab2line) {
  91     print "$me: Warning: No elements found for either label $lab1 nor $lab2\n";
  92     print "Nothing to compare!\n";
  93     exit;
  94   } # if
  95
  96   if (!$lab1line) {
  97     print "$me: Warning: No elements found for label $lab1\n";
  98     $lab1line = " ";
  99   } # if
 100
 101   if (!$lab2line) {
 102     print "$me: Warning: No elements found for label $lab2\n";
 103     $lab2line = " ";
 104   } # if
 105
 106   while ($lab1line && $lab2line) {
 107     # Extract versions and elements
 108     $version_start = rindex ($lab1line, "@") + 1;
 109     $version1      = substr ($lab1line, $version_start);
 110     $element1      = substr ($lab1line, 0, $version_start - 2);
 111     $version_start = rindex ($lab2line, "@") + 1;
 112     $version2      = substr ($lab2line, $version_start);
 113     $element2      = substr ($lab2line, 0, $version_start - 2);
 114
 115     # Change "\"'s to "/"'s
 116     $element1 =~ s/\\/\//g;
 117     $version1 =~ s/\\/\//g;
 118     $element2 =~ s/\\/\//g;
 119     $version2 =~ s/\\/\//g;
 120
 121     # Remove leading vob pathname
 122     $element1 =~ s/$vob\///;
 123     $element2 =~ s/$vob\///;
 124
 125     # Remove trailing carriage return and linefeed
 126     chop ($version1); chop ($version1);
 127     chop ($version2); chop ($version2);
 128
 129     # Compare element names
 130     if ($element1 eq $element2) {
 131       # Element has both labels
 132       if ($version1 ne $version2) {
 133         # Element has different version
 134         push (@diffs, "$element1 $version1 -> $version2");
 135       } # if
 136
 137       # Get next element/version
 138       $lab1line = shift (@lab1out);
 139       $lab2line = shift (@lab2out);
 140     } else {
 141       # Elements names are different
 142       if (!$element1) {
 143         # Element 1 is blank indicating there are no items in lab1out array
 144         # Push all of element 2
 145         push (@lab2only, $element2 . " " . $version2);
 146         $lab2line = shift (@lab2out);
 147       } elsif (!$element2) {
 148         # Element 2 is blank indicating there are no items in lab1out array
 149         # Push all of element 1
 150         push (@lab1only, $element1 . " " . $version1);
 151         $lab1line = shift (@lab1out);
 152       } elsif ($element1 lt $element2) {
 153         # Element 1 is less so get next element 1
 154         push (@lab1only, $element1 . " " . $version1);
 155         $lab1line = shift (@lab1out);
 156       } else {
 157         # Element 2 is less so get next element 2
 158         push (@lab2only, $element2 . " " . $version2);
 159         $lab2line = shift (@lab2out);
 160       } # if
 161     } # if
 162   } # while
 163
 164   # Output comparison listing
 165   print "Comparison of $lab1 -> $lab2\n";
 166
 167   if ($#diffs ne -1) {
 168     $nbrelements = $#diffs + 1;
 169     if ($nbrelements eq 1) {
 170       print "\nThe following $nbrelements element have both labels:\n\n";
 171     } else {
 172       print "\nThe following $nbrelements elements have both labels:\n\n";
 173     } # if
 174     PrintArray (@diffs);
 175   } # if
 176
 177   if ($#lab1only ne -1) {
 178     $nbrelements = $#lab1only + 1;
 179     if ($nbrelements eq 1) {
 180       print "\nThe following element only has the $lab1 label:\n\n";
 181     } else {
 182       print "\nThe following $nbrelements elements only have the $lab1 label:\n\n";
 183     } # if
 184     PrintArray (@lab1only);
 185   } # if
 186
 187   if ($#lab2only ne -1) {
 188     $nbrelements = $#lab2only + 1;
 189     if ($nbrelements eq 1) {
 190       print "\nThe following element only has the $lab2 label:\n\n";
 191     } else {
 192       print "\nThe following $nbrelements elements only have the $lab2 label:\n\n";
 193     } # if
 194     PrintArray (@lab2only);
 195   } # if
 196 } # ProcessLists
 197
 198 # Get options...
 199 if ($ARGV[0] eq "-g") {
 200   shift (@ARGV);
 201   $dynamic = 1;
 202 } else {
 203   $dynamic = 0;
 204 } # if
 205
 206 usage if $ARGV [0] eq "" || $ARGV [1] eq "";;
 207
 208 $lab1=$ARGV[0];
 209 $lab2=$ARGV[1];
 210
 211 $cwd = $ENV {PWD};
 212
 213 chdir ($vob) or die "Unable to chdir to $vob\n";
 214
 215 if (CheckLabel ($lab1)) {
 216   print "$me: Error: $lab1 is not a label\n";
 217   exit 1;
 218 } # if
 219
 220 if (CheckLabel ($lab2)) {
 221   print "$me: Error: $lab2 is not a label\n";
 222   exit 1;
 223 } # if
 224
 225 # Change backslashes to slashes as perl seems to have oddities with
 226 # backslashes
 227 $vob =~ s/\\/\//g;
 228
 229 ProduceLists;
 230 ProcessLists;
 231