#!/usr/bin/perl

#########################################################################
#
# trig_reservedonly.pl
#
# Description:
# This trigger is invoked when trying to checkout an element unreserved
# or when trying to unreserve an existing checkout.  The trigger checks
# for these actions and returns a message and a bad status so that
# the action in ClearCase fails.
#
# This trigger also has a self install feature.
#
#########################################################################
use strict;

my $TRIGGER_NAME = "trig_reservedonly";
my $WINPERL = "c:/program files/rational/clearcase/bin/ccperl";
my $UNIX_TRIG_EXE = "/net/MACHINE/PATH/trig_reservedonly.pl";
my $WIN_TRIG_EXE = "$WINPERL //MACHINE/PATH/trig_reservedonly.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;
}

sub adminmsg {
  print STDERR "\nError: You are attempting to perform an unreserved checkout.\n\n";
  print STDERR "This operation is not allowed in this VOB.\n";
  print STDERR "Please contact a ClearCase administrator with questions.\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 unreserved checkouts in the vob.\" "
    . " -element -all ${replace} "
    . " -nusers ${EXCLUDED_USERS} "
    . " -preop checkout,unreserve "
    . " -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;
}

# Get ClearCase environment variables passed in through invocation
# of the trigger.
my $op = $ENV{'CLEARCASE_OP_KIND'};
my $reserved = $ENV{'CLEARCASE_RESERVED'};

# If the user is trying to perform an unreserved checkout or unreserve
# an existing checkout, then it should call the adminmsg routine.
if ( (($op eq "checkout") && ($reserved eq "0")) || ($op eq "unreserve") ) { 
  &adminmsg();
}