CCDB/triggers/Element.pl

   1 #!/usr/bin/perl
   2
   3 =pod
   4
   5 =head1 NAME $RCSfile: Element.pl,v $
   6
   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.
  10
  11 =head1 VERSION
  12
  13 =over
  14
  15 =item Author
  16
  17 Andrew DeFaria <Andrew@ClearSCM.com>
  18
  19 =item Revision
  20
  21 $Revision: 1.6 $
  22
  23 =item Created:
  24
  25 Fri Mar 11 17:45:57 PST 2011
  26
  27 =item Modified:
  28
  29 $Date: 2011/04/02 00:34:01 $
  30
  31 =back
  32
  33 =head1 DESCRIPTION
  34
  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.
  42
  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.
  50
  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:
  54
  55  Trigger:        CCDB_ELEMENT_PRE
  56    Description:  Updates CCDB when an element's version is changed
  57    Type:         -element -all
  58    Opkinds:      -preop checkin,uncheckout,rmver
  59    ScriptEngine: Perl
  60    Script:       Element.pl
  61    Vobs:         base
  62  EndTrigger
  63
  64  Trigger:        CCDB_ELEMENT_POST
  65    Description:  Updates CCDB when an element's version is changed
  66    Type:         -element -all
  67    Opkinds:      -postop checkin,checkout,lnname,rmelem
  68    ScriptEngine: Perl
  69    Script:       Element.pl
  70    Vobs:         base
  71  EndTrigger
  72
  73 =cut
  74
  75 use strict;
  76 use warnings;
  77
  78 use FindBin;
  79 use File::Basename;
  80 use Data::Dumper;
  81
  82 $Data::Dumper::Indent = 0;
  83
  84 use lib $FindBin::Bin, "$FindBin::Bin/../lib", "$FindBin::Bin/../../lib";
  85
  86 use TriggerUtils;
  87 use CCDBService;
  88
  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 :-(
  91
  92 my $VERSION  = '$Revision: 1.6 $';
  93   ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
  94
  95 triglog 'Starting trigger';
  96
  97 my ($activity, $pvob);
  98
  99 if ($ENV{CLEARCASE_ACTIVITY}) {
 100   ($activity, $pvob) = split /\@/, $ENV{CLEARCASE_ACTIVITY};
 101
 102   trigdie 'Activity name not known', 1
 103     unless $activity;
 104
 105   trigdie 'Pvob name not known', 1
 106     unless $pvob;
 107
 108   $pvob = vobname $pvob;
 109 } # if
 110
 111 my ($elementName) =
 112   split /$ENV{CLEARCASE_XN_SFX}/, $ENV{CLEARCASE_XPN};
 113
 114 my ($cmd, $status, @output, $currVersion, $prevVersion);
 115
 116 unless ($ENV{CLEARCASE_OP_KIND} eq 'rmelem') {
 117   triglog "Getting current version for $elementName";
 118
 119  # Get the current, real version using describe;
 120   $cmd = "describe -fmt \"%Vn\" $elementName";
 121
 122   @output = `cleartool $cmd`; chomp @output;
 123   $status = $?;
 124
 125   trigdie "Unable to execute $cmd (Status: $status)\n"
 126         . join ("\n", @output), $status
 127     if $status;
 128
 129   $output[0] =~ s/\\/\//g;
 130
 131   $currVersion = $output[0];
 132
 133   triglog "currVersion = $currVersion";
 134
 135   triglog "Getting previous version for $elementName";
 136
 137   $cmd = "describe -fmt \"%PVn\" $elementName";
 138
 139   @output = `cleartool $cmd`; chomp @output;
 140   $status = $?;
 141
 142   trigdie "Unable to execute $cmd\n"
 143         . join ("\n", @output), $status
 144     if $status;
 145
 146   $output[0] ||= '';
 147
 148   $output[0] =~ s/\\/\//g;
 149
 150   $prevVersion = $output[0];
 151
 152   triglog "prevVersion = $prevVersion";
 153 } # unless
 154
 155 # Flip '\' -> '/'
 156 $elementName =~ s/\\/\//g;
 157
 158 # Remove any trailing '/' or '/.' in $elementName
 159 $elementName =~ s/(.*)\/\.*$/$1/;
 160
 161 # Collapse any '/./' -> '/'
 162 $elementName =~ s/\/\.\//\//g;
 163
 164 # Remove VIEWTAG_PREFIX
 165 $elementName = removeViewTag $elementName;
 166
 167 triglog "elementName: $elementName";
 168
 169 my $CCDBService = CCDBService->new;
 170
 171 trigdie 'Unable to connect to CCDBService', 1
 172   unless $CCDBService->connectToServer;
 173
 174 my ($err, $msg, $request);
 175
 176 triglog "CLEARCASE_OP_KIND: $ENV{CLEARCASE_OP_KIND}";
 177
 178 if ($ENV{CLEARCASE_OP_KIND} eq 'checkin' or
 179     $ENV{CLEARCASE_OP_KIND} eq 'checkout') {
 180   triglog "Processing $ENV{CLEARCASE_OP_KIND}";
 181
 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') {
 187     exit 0
 188       if $currVersion !~ /CHECKEDOUT/;
 189
 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';
 198
 199     open my $file, '>', $filename
 200       or trigdie "Unable to open $filename for writing - $!", 1;
 201
 202     print $file "$currVersion\n";
 203
 204     close $file;
 205
 206     exit 0;
 207   } else {
 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';
 213
 214     if (-e $checkedOutFile) {
 215       open my $file, '<', $checkedOutFile
 216         or trigdie "Unable to open $checkedOutFile - $!", 1;
 217
 218       my $version = <$file>; chomp $version;
 219
 220       close $file;
 221
 222       unlink $checkedOutFile;
 223
 224       $request = "DeleteChangeset $activity $elementName $version $pvob";
 225
 226       triglog "Executing request: $request";
 227
 228       ($err, $msg) = $CCDBService->execute ($request);
 229
 230       trigdie "Unable to execute request: $request\n"
 231             . join ("\n", @$msg), $err
 232         if $err;
 233     } # if
 234
 235     # Add this to the changeset
 236     my $changeset = Dumper {
 237       activity => $activity,
 238       element  => $elementName,
 239       version  => $currVersion,
 240       pvob     => $pvob,
 241     };
 242
 243     # Squeeze out extra spaces
 244     $changeset =~ s/ = /=/g;
 245     $changeset =~ s/ => /=>/g;
 246
 247     $request = "AddChangeset $changeset";
 248   } # if
 249 } elsif ($ENV{CLEARCASE_OP_KIND} eq 'uncheckout' or
 250          $ENV{CLEARCASE_OP_KIND} eq 'rmver') {
 251   triglog "Processing $ENV{CLEARCASE_OP_KIND}";
 252
 253   $request = "DeleteChangeset $activity $elementName $currVersion $pvob";
 254 } elsif ($ENV{CLEARCASE_OP_KIND} eq 'lnname') {
 255   triglog "Processing $ENV{CLEARCASE_OP_KIND}";
 256
 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...)
 261   exit 0
 262     if $ENV{CLEARCASE_POP_KIND} ne 'rmname';
 263
 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`;
 270   my $status = $?;
 271
 272   trigdie "Unable to execute $cmd (Status: $status)\n"
 273         . join ("\n", @output), $status
 274     if $status;
 275
 276   my ($activity, $pvob) = split /\@/, $output[0];
 277
 278   # Remove 'activity:' from $activity
 279   $activity = substr $activity, 9;
 280
 281   # Fix $pvob
 282   $pvob = vobname $pvob;
 283
 284   # Fix $ENV{CLEARCASE_PN2}
 285   my $oldName = $ENV{CLEARCASE_PN2};
 286
 287   # Switch "\"'s -> "/"'s
 288   $oldName =~ s/\\/\//g;
 289
 290   # Remove the viewtag
 291   $oldName = removeViewTag $oldName;
 292
 293   # Now update CCDB to reflect the move
 294   my $update = Dumper {
 295     element => $elementName,
 296   };
 297
 298   # Squeeze out extra spaces
 299   $update =~ s/ = /=/g;
 300   $update =~ s/ => /=>/g;
 301
 302   triglog "Updating $oldName -> $elementName";
 303
 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";
 308
 309   $request = "DeleteElementAll $elementName";
 310 } # if
 311
 312 triglog "Executing request: $request";
 313
 314 ($err, $msg) = $CCDBService->execute ($request);
 315
 316 trigdie "Unable to execute request: $request\n"
 317       . join ("\n", @$msg), $err
 318   if $err;
 319
 320 $CCDBService->disconnectFromServer;
 321
 322 triglog 'Ending trigger';
 323
 324 exit 0;
 325
 326 =pod
 327
 328 =head1 CONFIGURATION AND ENVIRONMENT
 329
 330 DEBUG: If set then $debug is set to this level.
 331
 332 VERBOSE: If set then $verbose is set to this level.
 333
 334 TRACE: If set then $trace is set to this level.
 335
 336 =head1 DEPENDENCIES
 337
 338 =head2 Perl Modules
 339
 340 L<FindBin>
 341
 342 L<Data::Dumper|Data::Dumper>
 343
 344 =head2 ClearSCM Perl Modules
 345
 346 =begin man
 347
 348  CCDBSerivce
 349  TriggerUtils
 350
 351 =end man
 352
 353 =begin html
 354
 355 <blockquote>
 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>
 358 </blockquote>
 359
 360 =end html
 361
 362 =head1 BUGS AND LIMITATIONS
 363
 364 There are no known bugs in this script
 365
 366 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
 367
 368 =head1 LICENSE AND COPYRIGHT
 369
 370 Copyright (c) 2011, ClearSCM, Inc. All rights reserved.
 371
 372 =cut