5 =head1 NAME $RCSfile: Element.pl,v $
7 This trigger will update CCDB when element versions are added or removed or
8 otherwise changed. The intent of this trigger is to keep CCDB's changeset table
9 up to date with respect to the element.
17 Andrew DeFaria <Andrew@ClearSCM.com>
25 Fri Mar 11 17:45:57 PST 2011
29 $Date: 2011/04/02 00:34:01 $
35 This trigger will update the CCDB when element versions are added or removed. It
36 is implemented as a post operation trigger on the checkin, checkout, lnname
37 and rmelem as well as a pre operation trigger on checkin, uncheckout and rmver.
38 This is because Clearcase creates a version that contains the string
39 "CHECKEDOUT" in order to list it in the change set. Thus we add it to CCDB.
40 However when a check in occurs for this element we need to remove the
41 "CHECKEDOUT" record and add the newly versioned version.
43 Also, lnname is trapped to handle when elments are moved, either through the
44 cleartool move command or in the odd circumstance of orphaning an element. You
45 can orphan an element in various ways. For example, if you check out a
46 directory, add an element to source control (mkelem) then cancel the directory
47 checkout there is no place for this new element to go! It's orphaned. In such
48 cases Clearcase will move the element to the vobs lost+found directory,
49 attaching the element's oid to the end of the element name.
51 This trigger should be attached to all UCM component vobs (i.e. vobs that have
52 UCM components but not pvobs) that you wish CCDB to monitor. If using
53 mktriggers.pl the triggers defintion are:
55 Trigger: CCDB_ELEMENT_PRE
56 Description: Updates CCDB when an element's version is changed
58 Opkinds: -preop checkin,uncheckout,rmver
64 Trigger: CCDB_ELEMENT_POST
65 Description: Updates CCDB when an element's version is changed
67 Opkinds: -postop checkin,checkout,lnname,rmelem
82 $Data::Dumper::Indent = 0;
84 use lib $FindBin::Bin, "$FindBin::Bin/../lib", "$FindBin::Bin/../../lib";
89 # I would like to use Clearcase but doing so causes a problem when the trigger
90 # is run from Clearcase Explorer - something about my use of open3 :-(
92 my $VERSION = '$Revision: 1.6 $';
93 ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
95 triglog 'Starting trigger';
97 my ($activity, $pvob);
99 if ($ENV{CLEARCASE_ACTIVITY}) {
100 ($activity, $pvob) = split /\@/, $ENV{CLEARCASE_ACTIVITY};
102 trigdie 'Activity name not known', 1
105 trigdie 'Pvob name not known', 1
108 $pvob = vobname $pvob;
112 split /$ENV{CLEARCASE_XN_SFX}/, $ENV{CLEARCASE_XPN};
114 my ($cmd, $status, @output, $currVersion, $prevVersion);
116 unless ($ENV{CLEARCASE_OP_KIND} eq 'rmelem') {
117 triglog "Getting current version for $elementName";
119 # Get the current, real version using describe;
120 $cmd = "describe -fmt \"%Vn\" $elementName";
122 @output = `cleartool $cmd`; chomp @output;
125 trigdie "Unable to execute $cmd (Status: $status)\n"
126 . join ("\n", @output), $status
129 $output[0] =~ s/\\/\//g;
131 $currVersion = $output[0];
133 triglog "currVersion = $currVersion";
135 triglog "Getting previous version for $elementName";
137 $cmd = "describe -fmt \"%PVn\" $elementName";
139 @output = `cleartool $cmd`; chomp @output;
142 trigdie "Unable to execute $cmd\n"
143 . join ("\n", @output), $status
148 $output[0] =~ s/\\/\//g;
150 $prevVersion = $output[0];
152 triglog "prevVersion = $prevVersion";
156 $elementName =~ s/\\/\//g;
158 # Remove any trailing '/' or '/.' in $elementName
159 $elementName =~ s/(.*)\/\.*$/$1/;
161 # Collapse any '/./' -> '/'
162 $elementName =~ s/\/\.\//\//g;
164 # Remove VIEWTAG_PREFIX
165 $elementName = removeViewTag $elementName;
167 triglog "elementName: $elementName";
169 my $CCDBService = CCDBService->new;
171 trigdie 'Unable to connect to CCDBService', 1
172 unless $CCDBService->connectToServer;
174 my ($err, $msg, $request);
176 triglog "CLEARCASE_OP_KIND: $ENV{CLEARCASE_OP_KIND}";
178 if ($ENV{CLEARCASE_OP_KIND} eq 'checkin' or
179 $ENV{CLEARCASE_OP_KIND} eq 'checkout') {
180 triglog "Processing $ENV{CLEARCASE_OP_KIND}";
182 # If checking in a version then we used to have a "CHECKEDOUT" version. We
183 # need to remove that if found first. Unfortunately a checkin can fail so
184 # we'll scribble on the filesystem to tell the postop to remove it.
185 if ($ENV{CLEARCASE_OP_KIND} eq 'checkin' and
186 $ENV{CLEARCASE_TRTYPE_KIND} eq 'pre-operation') {
188 if $currVersion !~ /CHECKEDOUT/;
190 # Create a file ending in .CHECKEDOUT that indicates the version of the of
191 # the previously checked out element that we need to remove from the
192 # database in the postop. However elements can be files or directories.
193 # For a directory create a ".CHECKEDOUT" file in the directory element.
194 my $filename = $TriggerUtils::VIEWTAG_PREFIX;
195 $filename .= "$ENV{CLEARCASE_VIEW_TAG}$elementName";
196 $filename .= '/' if -d $filename;
197 $filename .= '.CHECKEDOUT';
199 open my $file, '>', $filename
200 or trigdie "Unable to open $filename for writing - $!", 1;
202 print $file "$currVersion\n";
208 # Look for CHECKEDOUT file to indicate we must remove that from the database
209 my $checkedOutFile = $TriggerUtils::VIEWTAG_PREFIX;
210 $checkedOutFile .= "$ENV{CLEARCASE_VIEW_TAG}$elementName";
211 $checkedOutFile .= '/' if -d $checkedOutFile;
212 $checkedOutFile .= '.CHECKEDOUT';
214 if (-e $checkedOutFile) {
215 open my $file, '<', $checkedOutFile
216 or trigdie "Unable to open $checkedOutFile - $!", 1;
218 my $version = <$file>; chomp $version;
222 unlink $checkedOutFile;
224 $request = "DeleteChangeset $activity $elementName $version $pvob";
226 triglog "Executing request: $request";
228 ($err, $msg) = $CCDBService->execute ($request);
230 trigdie "Unable to execute request: $request\n"
231 . join ("\n", @$msg), $err
235 # Add this to the changeset
236 my $changeset = Dumper {
237 activity => $activity,
238 element => $elementName,
239 version => $currVersion,
243 # Squeeze out extra spaces
244 $changeset =~ s/ = /=/g;
245 $changeset =~ s/ => /=>/g;
247 $request = "AddChangeset $changeset";
249 } elsif ($ENV{CLEARCASE_OP_KIND} eq 'uncheckout' or
250 $ENV{CLEARCASE_OP_KIND} eq 'rmver') {
251 triglog "Processing $ENV{CLEARCASE_OP_KIND}";
253 $request = "DeleteChangeset $activity $elementName $currVersion $pvob";
254 } elsif ($ENV{CLEARCASE_OP_KIND} eq 'lnname') {
255 triglog "Processing $ENV{CLEARCASE_OP_KIND}";
257 # Exit if the previous operation (CLEARCASE_POP_KIND) was not an rmname. The
258 # user could just be doing an lnname. We want to capture only moves which, by
259 # definition need to be an rmname followed by an lnname. (What is an lnname
260 # followed by an rmname?!? The mktrtype man page is confusing on this...)
262 if $ENV{CLEARCASE_POP_KIND} ne 'rmname';
264 # Surprisingly Clearcase does not set CLEARCASE_ACTIVITY when a move is done
265 # in a UCM context! This may be because a move in a UCM context can only be
266 # done within the context of a view set to an activity. So let's get our
267 # current activity...
268 my $cmd = 'lsactivity -cact -fmt "%Xn"';
269 my @output = `cleartool $cmd`;
272 trigdie "Unable to execute $cmd (Status: $status)\n"
273 . join ("\n", @output), $status
276 my ($activity, $pvob) = split /\@/, $output[0];
278 # Remove 'activity:' from $activity
279 $activity = substr $activity, 9;
282 $pvob = vobname $pvob;
284 # Fix $ENV{CLEARCASE_PN2}
285 my $oldName = $ENV{CLEARCASE_PN2};
287 # Switch "\"'s -> "/"'s
288 $oldName =~ s/\\/\//g;
291 $oldName = removeViewTag $oldName;
293 # Now update CCDB to reflect the move
294 my $update = Dumper {
295 element => $elementName,
298 # Squeeze out extra spaces
299 $update =~ s/ = /=/g;
300 $update =~ s/ => /=>/g;
302 triglog "Updating $oldName -> $elementName";
304 $request = "UpdateChangeset $activity $oldName % $pvob $update";
305 } elsif ($ENV{CLEARCASE_OP_KIND} eq 'rmelem') {
306 # If we are doing rmelem then remove all traces of this element
307 triglog "Processing rmelem";
309 $request = "DeleteElementAll $elementName";
312 triglog "Executing request: $request";
314 ($err, $msg) = $CCDBService->execute ($request);
316 trigdie "Unable to execute request: $request\n"
317 . join ("\n", @$msg), $err
320 $CCDBService->disconnectFromServer;
322 triglog 'Ending trigger';
328 =head1 CONFIGURATION AND ENVIRONMENT
330 DEBUG: If set then $debug is set to this level.
332 VERBOSE: If set then $verbose is set to this level.
334 TRACE: If set then $trace is set to this level.
342 L<Data::Dumper|Data::Dumper>
344 =head2 ClearSCM Perl Modules
356 <a href="http://clearscm.com/php/scm_man.php?file=CCDB/lib/CCDBService.pm">CCDBService</a><br>
357 <a href="http://clearscm.com/php/scm_man.php?file=CCDB/triggers/TriggerUtils.pm">TriggerUtils</a><br>
362 =head1 BUGS AND LIMITATIONS
364 There are no known bugs in this script
366 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
368 =head1 LICENSE AND COPYRIGHT
370 Copyright (c) 2011, ClearSCM, Inc. All rights reserved.