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; |