#!/usr/bin/perl

#########################################################################
#
# trig_rmnamecheckout.pl
#
# Description:
# This trigger is invoked when trying to rmname an element.  The trigger
# stops users from performing an rmname if the element is checked out.
# (This is now the default behavior in ClearCase, but this trigger prevents
# the action when the user uses the -force option.)
#
# This trigger also has a self install feature.
#
#########################################################################
use strict;

my $TRIGGER_NAME = "trig_rmnamecheckout";
my $WINPERL = "c:/program files/rational/clearcase/bin/ccperl";
my $UNIX_TRIG_EXE = "/net/MACHINE/PATH/trig_rmnamecheckout.pl";
my $WIN_TRIG_EXE = "$WINPERL //MACHINE/PATH/trig_rmnamecheckout.pl";
my $ADMIN_EMAIL = "clearcase_admins\@x.com";
my $EXCLUDED_USERS = "invalid_user";
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;
}

sub adminmsg {
  print STDERR "\nError: Someone has this element checked out.\n";
  print STDERR "You can not remove the element while it is checked out.\n";
  print STDERR "Please contact a ClearCase administrator for help.\n";
  print STDERR "Administrators can be emailed at \"${ADMIN_EMAIL}\".\n\n";
  exit 1;
}

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 \"Prevent rmname when element is checked out.\" "
    . " -element -all ${replace} "
    . " -nusers ${EXCLUDED_USERS} "
    . " -preop rmname "
    . " -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"};

# Symlinks can't be checked out.
exit 0 if -l $pn;

if (qx($CT lsco -s -d "$pn")) {
  &adminmsg();
}