• Home
  • Services
    • Consultancy
    • Custom Software Solutions
    • Systems Adminsitration
    • Web Applications
    • Customers
  • SCM
    • Clearcase
      • Triggers
      • Evil Twin Finder
      • GUI DiffBL
      • View Ager
      • Open Source Builds
    • Clearquest
      • Clearquest Daemon
      • DB Conversions
    • Git
      • Repository
  • Scripting
    • Perl
    • ECRDig
  • Sysadm
    • Environment
  • About
    • Services
    • Our People
    • Contact Us
 

ClearSCM Inc.

You are viewing an unstyled version of this page. Either your browser does not support Cascading Style Sheets (CSS) or CSS styling has been disabled.

Checkin Trigger (code)

Trigger for checkins that utilizes the CQD API

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;

Last modified: October 17 2016 @ 8:12 pm
Copyright © 2021, ClearSCM Inc. - All rights reserved