#!/usr/bin/perl ######################################################################### # # trig_cleanbranch.pl # # Description: # This trigger is invoked when trying to perform the uncheckout command. # The trigger removes an empty branch if the zero version on the branch # does not have any labels, attributes, or hyperlinks attached to it. # # This trigger also has a self install feature. # ######################################################################### use strict; my $TRIGGER_NAME = "trig_cleanbranch"; my $WINPERL = "c:/program files/rational/clearcase/bin/ccperl"; my $UNIX_TRIG_EXE = "/net/MACHINE/PATH/trig_cleanbranch.pl"; my $WIN_TRIG_EXE = "$WINPERL //MACHINE/PATH/trig_cleanbranch.pl"; my $ADMIN_EMAIL = "clearcase_admins\@x.com"; my $EXCLUDED_USERS = "vobadmin"; my $OS = (eval{Win32::IsWinNT();},$@) ? "UNIX" : "NT"; my $ATRIAHOME; my $CT; if ($OS eq "NT") { $ATRIAHOME = $ENV{"ATRIA_HOME"} || 'c:/program files/rational/clearcase'; $CT = "$ATRIAHOME/bin/cleartool.exe"; (-x $CT) || die "Cannot find an executable cleartool"; $CT = "\"$CT\""; } else { $ATRIAHOME = "/opt/rational/clearcase"; $CT = "$ATRIAHOME/bin/cleartool"; (-x $CT) || die "Cannot find an executable cleartool"; } # subroutine determines the basename of the object sub basename { my ($pname) = @_; $_ = $pname; # The whole thing is the basename if there are no slashes return $pname unless /[\\\/]/; /(.*)[\\\/](.*)/; # $2 is the base name return $2; } my $me = &basename($0); my $usage = "Usage: $me [-i/nstall] [-r/eplace] [-v/ob vob-tag]\n" . " $me [-h]\n" . " $me\n"; my $install; my $replace; my $vob; while ($_ = shift(@ARGV)) { if (/^-i/) { $install = 1; next; } if (/^-r/) { $replace = "-replace"; next; } if (/^-v/) { $vob = shift(@ARGV); next; } if (/^-h/) { print($usage); exit 1; } } if ($install) { unless ($vob) { print ("Error: Vob not specified.\n"); exit 1; } # Check to see that it is a valid vob. my @voblist = `$CT lsvob -short $vob`; (my $vob_vf) = @voblist; chomp($vob_vf); if ($vob ne $vob_vf) { print ("Error: Invalid vob specified.\n"); exit 1; } # If the replace flag is not set, check to see if the trigger type # already exists on the vob. Fail if it already exists. if (! $replace) { my @triglist = `$CT lstype -short trtype:${TRIGGER_NAME}\@${vob}`; (my $trig) = @triglist; chomp($trig); if ($trig eq "${TRIGGER_NAME}") { print ("Error: Trigger already exists and -replace option not specified.\n"); exit 1; } } my $cmd = "$CT mktrtype " . " -c \"Remove empty branch.\" " . " -element -all ${replace} " . " -nusers ${EXCLUDED_USERS} " . " -postop uncheckout " . " -execunix ${UNIX_TRIG_EXE} " . " -execwin \"${WIN_TRIG_EXE}\" " . " ${TRIGGER_NAME}\@${vob} "; my @response = `${cmd}`; if (grep(/Error:/,@response)) { print ("Error: Trigger creation failed.\n"); exit 1; } print ("OK: Trigger successfully installed.\n"); exit 0; } my $pn = $ENV{"CLEARCASE_PN"}; my $branch_dir; my $branch_ver; # split, pop and join the CLEARCASE_XPN to get the directory name my @br_array = split(/[\\\/]/, $ENV{"CLEARCASE_XPN"}); pop(@br_array); if ($OS eq "NT") { $branch_dir = join("\\", @br_array); $branch_ver = "${branch_dir}\\0"; } else { $branch_dir = join("/", @br_array); $branch_ver = "${branch_dir}/0"; } my $brtype = pop(@br_array); # Check to see if there are any versions besides LATEST and 0 my @vers = `$CT ls -short \"$branch_dir\"`; chomp(@vers); foreach (@vers) { $_ = &basename($_); next if $_ eq "LATEST"; next if $_ eq "0"; exit 0; } # check for hyperlinks or attributes on the version my @status = `$CT describe \"${branch_ver}\"`; chomp(@status); my $stat = $?; if ($stat) { print("ERROR: Branch ${branch_ver} not removed"); exit 1; } my $numlines = @status; my $i; for ($i = 0; $i < $numlines; $i++) { $_ = $status[$i]; if (/^ Hyperlinks:$/) { exit 0; } if (/^ Attributes:$/) { exit 0; } } # exit if the branch name is main exit 0 if $branch_dir =~ /[\\\/]main$/; # remove the branch @status = `$CT rmbranch -force -nc \"$branch_dir\"`; chomp(@status); $stat = $?; if (! $stat) { $pn = &basename( $ENV{"CLEARCASE_PN"} ); print "Empty branch \"$brtype\" removed from \"$pn\".\n"; exit 0; } # oops! tell user something went wrong print("ERROR: Branch ${branch_ver} not removed"); exit 1;