defaria.com/Computers/code/bin/clearcase/triggers/CheckinPreop.pl

   1 #!/usr/bin/perl
   2 ################################################################################
   3 #
   4 # File:         CheckinPreop.pl
   5 # Description:  This trigger script is run when the user is attempting to
   6 #               checkin. Several checks are performed on the check in comment.
   7 #               The comment should contain the bug ID, which we will later used
   8 #               to label this element checkin (See CheckinPostop.pl). We will
   9 #               also check to insure the bug ID is valid in Clearquest and that
  10 #               the bug is in the proper state.
  11 #
  12 #               If the check in is on the "main" or "trial" branch then we will
  13 #               consult a file to insure that the bug ID is listed. This is an
  14 #               additional method for limiting checkins.
  15 # Assumptions:  Clearprompt is in the users PATH
  16 # Author:       Andrew@DeFaria.com
  17 # Created:      Fri Oct 26 15:32:12  2001
  18 # Language:     Perl
  19 # Modifications:6/25/2002: Added check to see if a bug ID label exists and it
  20 #               is locked. If so then that's an indication that we should not
  21 #               allow the checkin.
  22 #               6/20/2002: Added interface to cqd to verify that the bug exists
  23 #               in Clearquest, is of a certain state and has an owner
  24 #               5/15/2002: Added tests so that bug IDs must exist in
  25 #               mainbugs.txt or trialbugs.txt for the main and trial branches.
  26 #               5/17/2002: Exempted EMS code.
  27 #               5/31/2002: Exempted hardware code.
  28 #               10/22/2002: Changed to allow checkins to main branch with no
  29 #               bug IDs. Removed $mainbugs.
  30 #               11/20/2002: It was determined to relax restrictions of checkins
  31 #               for non 1.0 branches such that bug ID's are not required, in fact
  32 #               they are not allowed.
  33 #               04/11/2003: Added support for multiple bug IDs in the comment
  34 #               05/18/2003: Changed code to only check for bug IDs in comments
  35 #               for check ins on certain branches.
  36 #
  37 # (c) Copyright 2003, Andrew@DeFaria.com, all rights reserved
  38 #
  39 ################################################################################
  40 use strict;
  41
  42 my $site;
  43
  44 BEGIN {
  45   # Add the appropriate path to our modules to @INC array. We use ipconfig to
  46   # get the current host's IP address then determine whether we are in the US
  47   # or China.
  48   my @ipconfig = grep (/IP Address/, `ipconfig`);
  49   my ($ipaddr) = ($ipconfig[0] =~ /(\d{1,3}\.\d{1,3}.\d{1,3}\.\d{1,3})/);
  50
  51   # US is in the subnets of 192 and 172 while China is in the subnet of 10
  52   if ($ipaddr =~ /^192|^172/) {
  53     $site = "US";
  54     unshift (@INC, "//sons-clearcase/Views/official/Tools/lib");
  55   } elsif ($ipaddr =~ /^10/) {
  56     $site = "CN";
  57     unshift (@INC, "//sons-cc/Views/official/Tools/lib");
  58   } else {
  59     die "Internal Error: Unable to find our modules!\n"
  60   } # if
  61 } # BEGIN
  62
  63 use TriggerUtils;
  64 use cqc;
  65
  66 %cqc::fields;
  67
  68 # The following environment variables are set by Clearcase when this
  69 # trigger is called
  70 my $comment = $ENV{CLEARCASE_COMMENT};
  71 my $branch  = $ENV{CLEARCASE_BRTYPE};
  72 my $pname   = $ENV{CLEARCASE_PN};
  73
  74 # Which vob we will look up labels in
  75 my $vob = "salira";
  76
  77 my $bugid;
  78
  79 sub ExtractBugID {
  80   my $comment = shift;
  81
  82   my @fields  = split (/\W/,$comment);
  83   my $bugid   = "unknown";
  84
  85   foreach (@fields) {
  86     if (/BUGS2[0-9]{8}/) {
  87       $bugid = $_;
  88       last;
  89     } # if
  90   } # foreach
  91
  92   return $bugid;
  93 } # ExtractBugID
  94
  95 sub ExtractBugIDs {
  96   my $comment = shift;
  97
  98   my @fields  = split (/\W/,$comment);
  99
 100   # Use associative array to insure uniqueness
 101   my %bugids;
 102   # Return unique array
 103   my @bugids;
 104
 105   foreach (@fields) {
 106     if (/BUGS2[0-9]{8}/) {
 107       $bugids{$_} = $_;
 108     } # if
 109   } # foreach
 110
 111   foreach (keys %bugids) {
 112     push @bugids, $_;
 113   }
 114
 115   return @bugids;
 116 } # ExtractBugIDs
 117
 118 sub BugOnList {
 119   my $bugid       = shift;
 120   my $branch      = shift;
 121
 122   my $found_bugid = 0;
 123   my $bug         = "unknown";
 124
 125   # Excempt EMS code
 126   return 1 if $pname =~ /salira\\ems/i;
 127
 128   # Excempt Hardware code
 129   return 1 if $pname =~ /salira\\hardware/i;
 130
 131   # Exempt bug ID 2912
 132   return 1 if $bugid eq "BUGS200002912";
 133
 134   # Exempt bug ID 3035
 135   return 1 if $bugid eq "BUGS200003035";
 136
 137   my $filename;
 138
 139   if ($site eq "US") {
 140     $filename = "//sons-clearcase/Views/official/Tools/bin/clearcase/triggers/data/$branch.lst";
 141   } elsif ($site eq "CN") {
 142    $filename = "//sons-cc/Views/official/Tools/bin/clearcase/triggers/data/$branch.lst";
 143  } else {
 144    die "Internal Error: Site not set properly! ($site)\n";
 145  } # if
 146
 147   if (-f $filename) {
 148     open (FILE, $filename) || die "Can't open $filename!\n";
 149
 150     while (<FILE>) {
 151       $bug = ExtractBugID $_;
 152       next if ($bug eq "unknown");
 153       if ($bug eq $bugid) {
 154         $found_bugid = 1;
 155         last;
 156       } # if
 157     } # while
 158
 159     close (FILE);
 160   } else {
 161     clearlog "Skipping check because $filename does not exist!";
 162     # Since there is no file list to check return that the bug id was found
 163     $found_bugid = 1;
 164   } # if
 165
 166   return $found_bugid;
 167 } # BugOnList
 168
 169 sub LabelLocked {
 170   # 04/28/2003: Oddity! All of a sudden this subroutine broke! I don't know
 171   # why but even though we used to cd to the official view and issue our
 172   # cleartool lslock command we started getting "Unable to determine VOB
 173   # from pname" errors. Weird! Anyways we have changed to use the @<vob
 174   # selector> syntax instead. This means we must now specify the vob
 175   # specifically. Fortunately we only have one vob to worry about at this
 176   # time. On the plus side we no longer need to rely on the "official" view.
 177   my $bugid = shift;
 178
 179   my $output = `cleartool lslock -short lbtype:$bugid@\\$vob 2>&1`;
 180
 181   if ($? == 0) {
 182     return $output;
 183   } else {
 184     return 0;
 185   } # if
 186 } # LabelLocked
 187
 188 sub CheckComment {
 189   my $comment = shift;
 190   my $branch  = shift;
 191
 192   my @valid_branches = (
 193     "main",
 194     "rel_1.0",
 195     "rel_2.0",
 196     "rel_2.1",
 197     "rel_2.2",
 198     "rel_2.3",
 199     "china_1.0",
 200     "china_2.0",
 201     "china_2.1",
 202     "china_2.2",
 203     "china_2.3",
 204     "2.0_ga"
 205   );
 206
 207   if ($comment eq "") {
 208     clearlogmsg "You need to specify checkin comments";
 209     return 1;
 210   } # if
 211
 212   if (length $comment <= 4) {
 213     clearlogmsg "The comment, '$comment' is too short!";
 214     return 1;
 215   } # if
 216
 217   if ($comment !~ m/.*BUGS2[0-9]{8}.*/) {
 218     # Bug ID's are only required on certain branches
 219     my $found = 0;
 220
 221     foreach (@valid_branches) {
 222       if ($branch eq $_) {
 223         $found = 1;
 224         last;
 225       } # if
 226     } # foreach
 227
 228     if ($found == 1) {
 229       clearlogmsg "Could not find bug ID in comment! This is required for the $branch branch";
 230       return 1;
 231     } # if
 232   } # if
 233
 234   return 0;
 235 } # CheckComment
 236
 237 sub CheckBugIDs {
 238   my @bugs = @_;
 239
 240   my $result;
 241
 242   foreach my $bugid (@bugs) {
 243     # Check if label is locked
 244     if (LabelLocked ($bugid)) {
 245       clearlog "Bug id $bugid is locked!";
 246       clearmsg "Bug id $bugid is locked!\nSee your Clearcase Admin to unlock it";
 247       return 1;
 248     } # if
 249
 250     # Get Clearquest information
 251     $result = cqc::GetBugRecord ($bugid, %fields);
 252
 253     if ($result == 0) {
 254       # Make sure bug is owned
 255       if ($fields {owner} eq "<Unspecified>") {
 256         clearlogmsg "No owner specified in Clearquest for bug ID $bugid.";
 257         return 1;
 258       } # if
 259
 260       # Make sure bug is in the correct state
 261       if ($fields {state} ne "Assigned" and $fields {state} ne "Resolved") {
 262         clearlogmsg "Bug ID $bugid is in the wrong state. It is in the " . $fields {state}. " state but should be in Assigned or Resolved state.";
 263         return 1;
 264       } # if
 265     } elsif ($result > 0) {
 266       clearlogmsg "Bug ID $bugid is not in Clearquest.";
 267       return 1;
 268     } else {
 269       clearlogmsg "Clearquest Daemon (cqd) is not running!
 270 Please contact the Clearquest Administrator.";
 271       return 1;
 272     } # if
 273
 274     # Check if bug is on a branch list file
 275     if (! BugOnList ($bugid, $branch)) {
 276       clearlog "Bug ID $bugid is not on the list of acceptable bugs for the $branch branch!";
 277       clearmsg "Bug ID $bugid is not on the list\nof acceptable bugs for the $branch branch!";
 278       return 1;
 279     } # if
 280   } # foreach
 281 } # CheckBugIDs
 282
 283 clearlog "Checkin checks started for $pname on $branch branch";
 284
 285 if (CheckComment ($comment, $branch)) {
 286   exit 1;
 287 } elsif (CheckBugIDs (ExtractBugIDs $comment)) {
 288   exit 1;
 289 } # if
 290
 291 clearlog "Successful precheckin of $pname on $branch branch with bug ID $bugid";
 292
 293 exit 0;