| 1 | #!/usr/bin/perl |
| 2 | ################################################################################# |
| 3 | # |
| 4 | # File: mktriggers,v |
| 5 | # Revision: 1.1.1.1 |
| 6 | # Description: Parses triggers.dat and created trigger types in vobs |
| 7 | # Author: Andrew@DeFaria.com |
| 8 | # Created: Mon Mar 15 08:48:24 PST 2004 |
| 9 | # Modified: 2007/05/17 07:45:48 |
| 10 | # Language: None |
| 11 | # |
| 12 | # (c) Copyright 2004, ClearSCM, Inc., all rights reserved. |
| 13 | # |
| 14 | ################################################################################ |
| 15 | use strict; |
| 16 | use warnings; |
| 17 | use File::Spec; |
| 18 | |
| 19 | # This will be set in the BEGIN block but by putting them here the become |
| 20 | # available for the whole script. |
| 21 | my $me; |
| 22 | my $abs_path; |
| 23 | |
| 24 | BEGIN { |
| 25 | # Set $lib_path |
| 26 | my $lib_path = $^O =~ /MSWin/ ? "\\\\brcm-irv\\dfs\\projects\\ccase\\SCM\\lib" |
| 27 | : "/projects/ccase/SCM/lib"; |
| 28 | |
| 29 | # Extract relative path and basename from script name. |
| 30 | $0 =~ /(.*)[\/\\](.*)/; |
| 31 | |
| 32 | $abs_path = (!defined $1) ? "." : File::Spec->rel2abs ($1); |
| 33 | $me = (!defined $2) ? $0 : $2; |
| 34 | $me =~ s/\.pl$//; |
| 35 | |
| 36 | # Add the appropriate path to our modules to @INC array. |
| 37 | unshift @INC, $ENV {SITE_PERL_LIBPATH} if defined $ENV {SITE_PERL_LIBPATH}; |
| 38 | unshift @INC, "$lib_path"; |
| 39 | unshift @INC, "$abs_path"; |
| 40 | } # BEGIN |
| 41 | |
| 42 | use Display; |
| 43 | use OSDep; |
| 44 | |
| 45 | # Assumes triggers, lib, etc are one directory up |
| 46 | chdir "$abs_path${separator}.."; |
| 47 | |
| 48 | my $base_path = `pwd`; |
| 49 | chomp $base_path; |
| 50 | |
| 51 | my $windows_trig_path = "\\\\fs-rmna-01\\Projects-V0\\cc4\\triggers"; |
| 52 | my $linux_trig_path = "/projects/cc4/triggers"; |
| 53 | my $etc_path = "$base_path${separator}etc"; |
| 54 | |
| 55 | # Options |
| 56 | my $execute = "yes"; |
| 57 | my $perform_replace = "no"; |
| 58 | my $perform_add = "no"; |
| 59 | my $private_vobs = "no"; |
| 60 | |
| 61 | sub Usage { |
| 62 | display "Usage $me: [-u] [-n] [-a] [-r] [-v] [-p] [ -vobs ]"; |
| 63 | display "Where:"; |
| 64 | display "\t-u\tDisplays this usage"; |
| 65 | display "\t-n\tNo execute mode - just echo out what would have been done"; |
| 66 | display "\t-r\tPerform only replacements of triggers (Default: Don't perform"; |
| 67 | display "\t\treplacements - Note: If neither -r nor -a are specified then"; |
| 68 | display "\t\tboth adds and replacements are done)"; |
| 69 | display "\t-a\tPerform only adds of triggers that are missing (Default: Don't"; |
| 70 | display "\t\tperform adds - Note: If neither -r nor -a are specified then"; |
| 71 | display "\t\tboth adds and replacements are done)"; |
| 72 | display "\t-v\tVerbose"; |
| 73 | display "\t-p\tInclude private vobs (Default: Skip private vobs)"; |
| 74 | display "\t-d\tDebug"; |
| 75 | display "\t-vobs\tList of vob tags to apply triggers to (default all vobs)"; |
| 76 | exit 1; |
| 77 | } # Usage |
| 78 | |
| 79 | sub ParseTriggerData { |
| 80 | my $triggers_dat = "$etc_path/triggers.dat"; |
| 81 | |
| 82 | open TRIGGERS, $triggers_dat |
| 83 | or error "Unable to open $triggers_dat ($!)", 1; |
| 84 | |
| 85 | my @triggers; |
| 86 | my ($name, $desc, $type, $opkinds, $engine, $script, $vobs); |
| 87 | |
| 88 | while () { |
| 89 | chomp; chop if /\r/; |
| 90 | |
| 91 | next if /^$/; # Skip blank lines |
| 92 | next if /^\#/; # and comments |
| 93 | |
| 94 | if (/^Trigger:\s*(.*)/) { |
| 95 | $name = $1; |
| 96 | next; |
| 97 | } # if |
| 98 | |
| 99 | if (/^Description:\s*(.*)/) { |
| 100 | $desc = $1; |
| 101 | next; |
| 102 | } # if |
| 103 | |
| 104 | if (/^Type:\s*(.*)/) { |
| 105 | $type = $1; |
| 106 | next; |
| 107 | } # if |
| 108 | |
| 109 | if (/^Opkinds:\s*(.*)/) { |
| 110 | $opkinds = $1; |
| 111 | next; |
| 112 | } # if |
| 113 | |
| 114 | if (/^ScriptEngine:\s*(.*)/) { |
| 115 | $engine = $1; |
| 116 | next; |
| 117 | } # if |
| 118 | |
| 119 | if (/^Script:\s*(.*)/) { |
| 120 | $script = $1; |
| 121 | next; |
| 122 | } # if |
| 123 | |
| 124 | if (/^Vobs:\s*(.*)/) { |
| 125 | $vobs = $1; |
| 126 | next; |
| 127 | } # if |
| 128 | |
| 129 | if (/^EndTrigger/) { |
| 130 | my %trigger; |
| 131 | |
| 132 | $trigger{name} = $name; |
| 133 | $trigger{desc} = $desc; |
| 134 | $trigger{type} = $type; |
| 135 | $trigger{opkinds} = $opkinds; |
| 136 | $trigger{engine} = $engine; |
| 137 | $trigger{script} = $script; |
| 138 | $trigger{vobs} = !defined $vobs ? "all" : $vobs; |
| 139 | |
| 140 | push (@triggers, \%trigger); |
| 141 | |
| 142 | $name = $desc = $type = $opkinds = $engine = $script = $vobs = ""; |
| 143 | } # if |
| 144 | } # while |
| 145 | |
| 146 | return @triggers; |
| 147 | } # ParseTriggerData |
| 148 | |
| 149 | sub MkTriggerType { |
| 150 | my $vob = shift; |
| 151 | my $execute = shift; |
| 152 | my $perform_add = shift; |
| 153 | my $perform_replace = shift; |
| 154 | my %trigger = @_; |
| 155 | |
| 156 | debug "ENTER: MkTriggerType ($vob, $execute, $perform_add, $perform_replace, $trigger{name})"; |
| 157 | my $replace = ""; |
| 158 | |
| 159 | # Need an extra set of "\\" for non Windows systems such as Cygwin |
| 160 | # since apparently the shell if envoked, collapsing a set of "\\". |
| 161 | my $vobtag = ($arch eq "cygwin") ? "\\" . $vob : $vob; |
| 162 | |
| 163 | my $status = system ("cleartool lstype trtype:$trigger{name}\@$vobtag > $null 2>&1"); |
| 164 | |
| 165 | if ($status eq 0) { |
| 166 | debug "Found pre-existing trigger $trigger{name}"; |
| 167 | # If we are not replacing then skip by returning |
| 168 | return if $perform_replace ne "yes"; |
| 169 | $replace = "-replace"; |
| 170 | } else { |
| 171 | debug "No pre-existing trigger $trigger{name}"; |
| 172 | # We need to add the trigger. However, if we are not adding then skip by returning |
| 173 | return if $perform_add ne "yes"; |
| 174 | } # if |
| 175 | |
| 176 | error "Sorry I only support ScriptEngines of Perl!" if $trigger{engine} ne "Perl"; |
| 177 | |
| 178 | # my $win_path = "C:\\Program Files\\Rational\\Clearcase\\bin"; |
| 179 | # my $win_engine = "$win_path\\ccperl"; |
| 180 | # my $linux_path = "/opt/rational/clearcase/bin"; |
| 181 | # my $linux_engine = "$linux_path/Perl"; |
| 182 | |
| 183 | # # Alas, all we can check is the OS we are running on... |
| 184 | # if ($arch eq "windows" or $arch eq "cygwin") { |
| 185 | # error "Unable to find (Windows) ccperl at $win_engine", 1 if !-f $win_engine; |
| 186 | # } else { |
| 187 | # error "Unable to find (Linux) Perl at $linux_engine", 1 if !-x $linux_engine; |
| 188 | # } # if |
| 189 | |
| 190 | my $win_engine = "ccperl"; |
| 191 | my $linux_engine = "Perl"; |
| 192 | |
| 193 | my ($script, $parm) = split / /,"$trigger{script}"; |
| 194 | |
| 195 | $parm = "" if !defined $parm; |
| 196 | my $win_script = "\\$windows_trig_path\\$script"; |
| 197 | my $linux_script = "$linux_trig_path/$script"; |
| 198 | |
| 199 | if ($arch eq "windows") { |
| 200 | error "Unable to find trigger script $win_script ($!)" if ! -e $win_script; |
| 201 | } else { |
| 202 | error "Unable to find trigger script $linux_script ($!)" if ! -e $linux_script; |
| 203 | } # if |
| 204 | |
| 205 | my $command = |
| 206 | "cleartool mktrtype " . |
| 207 | "$replace " . |
| 208 | "$trigger{type} " . |
| 209 | "$trigger{opkinds} " . |
| 210 | "-comment \"$trigger{desc}\" " . |
| 211 | "-execwin \"$win_engine ${win_script} $parm\" " . |
| 212 | "-execunix \"$linux_engine ${linux_script} $parm\" " . |
| 213 | "$trigger{name}\@$vobtag " . |
| 214 | "> $null 2>&1"; |
| 215 | |
| 216 | $vob =~ s/\\\\/\\/; |
| 217 | |
| 218 | if ($execute eq "no") { |
| 219 | if ($replace ne "") { |
| 220 | display "[noexecute] Would have replaced trigger $trigger{name} in vob $vob"; |
| 221 | verbose "Command: $command"; |
| 222 | } else { |
| 223 | display "[noexecute] Would have added the trigger $trigger{name} to vob $vob"; |
| 224 | verbose "Command: $command"; |
| 225 | } # if |
| 226 | return; |
| 227 | } # if |
| 228 | |
| 229 | if ($replace ne "") { |
| 230 | display "Replacing trigger $trigger{name} in vob $vob...", undef, "nolf"; |
| 231 | } else { |
| 232 | display "Adding trigger $trigger{name} to vob $vob...", undef, "nolf"; |
| 233 | } # if |
| 234 | |
| 235 | $status = 0; |
| 236 | $status = system $command if $execute eq "yes"; |
| 237 | |
| 238 | if ($status eq 0) { |
| 239 | display " done"; |
| 240 | } else { |
| 241 | error "Unable to add trigger! Status = $status\nCommand: $command"; |
| 242 | } # if |
| 243 | } # MkTriggerType |
| 244 | |
| 245 | sub VobType { |
| 246 | my $vob = shift; |
| 247 | |
| 248 | # Need an extra set of "\\" for non Windows systems such as Cygwin |
| 249 | # since apparently the shell if envoked, collapsing a set of "\\". |
| 250 | $vob = "\\" . $vob if $arch eq "cygwin"; |
| 251 | |
| 252 | my @lines = `cleartool describe vob:$vob`; |
| 253 | |
| 254 | foreach (@lines) { |
| 255 | chomp; # newline |
| 256 | chop if /\r/; # any carriage return |
| 257 | if (/AdminVOB \<-/) { |
| 258 | return "ucm"; |
| 259 | } # if |
| 260 | } # foreach |
| 261 | |
| 262 | return "base"; |
| 263 | } # VobType |
| 264 | |
| 265 | sub MkTriggers { |
| 266 | my $vob = shift; |
| 267 | my $execute = shift; |
| 268 | my $perform_add = shift; |
| 269 | my $perform_replace = shift; |
| 270 | my @triggers = @_; |
| 271 | |
| 272 | foreach (@triggers) { |
| 273 | my %trigger = %{$_}; |
| 274 | |
| 275 | debug "Processing trigger $trigger{name}"; |
| 276 | |
| 277 | # For triggers whose vob type is "all" or unspecified make the trigger |
| 278 | if ($trigger{vobs} eq "all" || $trigger{vobs} eq "") { |
| 279 | MkTriggerType $vob, $execute, $perform_add, $perform_replace, %trigger; |
| 280 | } elsif ($trigger{vobs} eq "base" || $trigger{vobs} eq "ucm") { |
| 281 | # If vob type is "base" or "ucm" make sure the vob is of correct type |
| 282 | my $vob_type = VobType $vob; |
| 283 | |
| 284 | if ($vob_type eq $trigger{vobs}) { |
| 285 | # Types match, make the trigger |
| 286 | MkTriggerType $vob, $execute, $perform_add, $perform_replace, %trigger; |
| 287 | } else { |
| 288 | verbose "Trigger $trigger{name} is for $trigger{vobs} vobs but $vob is a $vob_type vob - Skipping..."; |
| 289 | } # if |
| 290 | } else { |
| 291 | debug "Processing vob list $trigger{vobs}"; |
| 292 | my @Vobs = split /\s/, $trigger{vobs}; |
| 293 | |
| 294 | # Otherwise we expect the strings in $triggers{vobs} to be space |
| 295 | # separated vob tags so we make sure it matches this $vob. |
| 296 | foreach (@Vobs) { |
| 297 | # First let's make vobs just the tag name for easier comparison. |
| 298 | # This means changing Windows vob tags from \ -> |
| 299 | # and Unix vobnames from the (common) /vobs/ -> |
| 300 | my $vobname = $vob; |
| 301 | |
| 302 | if ($arch eq "windows") { |
| 303 | # Strip leading \ if necessary from both $_ (the current vob |
| 304 | # from @Vobs) and $vobname (the passed in vob we are processing) |
| 305 | s/^\\//; |
| 306 | $vobname =~ s/^\\*//; |
| 307 | } else { |
| 308 | # Strip leading /vobs/ if necessary from both $_ (the current vob |
| 309 | # from @Vobs) and $vobname (the passed in vob we are processing) |
| 310 | s/^\/vobs\///; |
| 311 | $vobname =~ s/^\/vobs\///; |
| 312 | } # if |
| 313 | |
| 314 | # Now the vob tags are normalized. |
| 315 | debug "vobname = \"$vobname\""; |
| 316 | debug "\$_ = \"$_\""; |
| 317 | if ($vobname eq "$_") { |
| 318 | MkTriggerType $vob, $execute, $perform_add, $perform_replace, %trigger; |
| 319 | last; |
| 320 | } # if |
| 321 | } # foreach |
| 322 | } # if |
| 323 | } # foreach |
| 324 | } # MkTriggers |
| 325 | |
| 326 | my @vobs; |
| 327 | |
| 328 | # Get parms |
| 329 | while ($#ARGV >= 0) { |
| 330 | if ($ARGV [0] eq "-n") { |
| 331 | $execute = "no"; |
| 332 | shift; |
| 333 | next; |
| 334 | } # if |
| 335 | |
| 336 | if ($ARGV [0] eq "-a") { |
| 337 | $perform_add = "yes"; |
| 338 | shift; |
| 339 | next; |
| 340 | } # if |
| 341 | |
| 342 | if ($ARGV [0] eq "-r") { |
| 343 | $perform_replace = "yes"; |
| 344 | shift; |
| 345 | next; |
| 346 | } # if |
| 347 | |
| 348 | if ($ARGV [0] eq "-v") { |
| 349 | Display::set_verbose; |
| 350 | shift; |
| 351 | next; |
| 352 | } # if |
| 353 | |
| 354 | if ($ARGV [0] eq "-d") { |
| 355 | Display::set_debug; |
| 356 | shift; |
| 357 | next; |
| 358 | } # if |
| 359 | |
| 360 | if ($ARGV [0] eq "-p") { |
| 361 | $private_vobs = "yes"; |
| 362 | shift; |
| 363 | next; |
| 364 | } # if |
| 365 | |
| 366 | if ($ARGV [0] eq "-vobs") { |
| 367 | shift; |
| 368 | foreach (@ARGV) { |
| 369 | if ($arch eq "windows") { |
| 370 | s/^\\//; # Remove any leading backslashes - we'll add them next. |
| 371 | push @vobs, ("\\" . $_); |
| 372 | } else { |
| 373 | push @vobs, $_; |
| 374 | } # if |
| 375 | } # foreach |
| 376 | last; |
| 377 | } # if |
| 378 | |
| 379 | Usage if $ARGV [0] eq "-u"; |
| 380 | |
| 381 | if ($ARGV [0] ne "") { |
| 382 | display "Unknown option: \"" . $ARGV [0] . "\""; |
| 383 | Usage; |
| 384 | } # if |
| 385 | } # while |
| 386 | |
| 387 | if ($perform_add eq "no" and $perform_replace eq "no") { |
| 388 | # User did not specify whether to perform adds or replaces so we'll do both |
| 389 | $perform_add = $perform_replace = "yes"; |
| 390 | } # if |
| 391 | |
| 392 | if ($#vobs eq -1) { |
| 393 | @vobs = `cleartool lsvob -short`; |
| 394 | } # if |
| 395 | |
| 396 | # Parse the triggers.dat file |
| 397 | my @triggers = ParseTriggerData; |
| 398 | |
| 399 | # Iterrate through the list of vobs |
| 400 | foreach (sort @vobs) { |
| 401 | chomp; # newline |
| 402 | chop if /\r/; # any carriage return |
| 403 | |
| 404 | # Need an extra set of "\\" for non Windows systems such as Cygwin |
| 405 | # since apparently the shell if envoked, collapsing a set of "\\". |
| 406 | my $vob = ($arch eq "cygwin") ? "\\" . $_ : $_; |
| 407 | my $line = `cleartool lsvob $vob`; |
| 408 | |
| 409 | # Skip private vobs |
| 410 | if ($line =~ / private/ and $private_vobs ne "yes") { |
| 411 | verbose "Skipping private vob: $_..."; |
| 412 | next; |
| 413 | } # if |
| 414 | |
| 415 | MkTriggers $_, $execute, $perform_add, $perform_replace, @triggers; |
| 416 | } # foreach |
| 417 | |
| 418 | # All done... |
| 419 | exit 0; |