| 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 () { |
| 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 @ |
| 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 "") { |
| 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; |