#!/bin/perl
use ClearCase::ClearPrompt qw(:all);
use ClearCase::Argv qw(ctsystem ctexec ctqx);
# Deal with the possibility of no display on Unix.
BEGIN { $ENV{ATRIA_FORCE_GUI} = $^O =~ /win32/i ? 1 : $ENV{DISPLAY} }
#--------------------------------------------------------------------
# Debugging aid. Overloading the semantics of the standard
# CLEARCASE_TRACE_TRIGGERS EV: if it's set to -2 we dump
# the runtime environment into a file in the current dir.
#--------------------------------------------------------------------
if (int($ENV{CLEARCASE_TRACE_TRIGGERS}) < 0 &&
$ENV{CLEARCASE_TRACE_TRIGGERS} & 0x2) {
open (EV, ">chk_dup_elems_env.txt");
print EV "$x=$y\n" while (($x,$y) = each %ENV);
close EV;
}
#--------------------------------------------------------------------
# See if the user wants to suppress this trigger's actions:
#--------------------------------------------------------------------
exit 0 if $ENV{CCASE_NO_CHK_DUP_ELEMS};
#--------------------------------------------------------------------
# Figure out the null device.
#--------------------------------------------------------------------
$null = $^O =~ /win32/i ? 'NUL' : '/dev/null';
#--------------------------------------------------------------------
# Catch some really bad pathnames - we can't catch everything, but
# let's try to be good.
#--------------------------------------------------------------------
$elname = $ENV{CLEARCASE_PN};
$elname =~ s,\\,/,g if $ENV{OS} eq 'Windows_NT';
$elname =~ s,/*$,,;
if ($elname =~ /[\"\(\)\{\}\[\]\\\'\^~\!\#]/ || # illegal characters;
$elname =~ /\s+\// || # leading or trailing
$elname =~ /\/\s+/ || # spaces at slashes,
$elname =~ /^\s+/ || # or at the beginning
$elname =~ /\s+$/ || # or at the end;
$elname =~ /\.$/) # trailing dot.
{
# substitute offenders with X
$elname =~ s/[\"\(\)\{\}\[\]\\\'\^~\!\#]/X/g;
$elname =~ s/\s+\//X\// ||
$elname =~ s/\/\s+/\/X/ ||
$elname =~ s/^\s+/X/;
$elname =~ s/\s+$/X/;
$prompt = <<EOT;
ERROR: The new element name contains characters
that will cause problems in many scripts.
Please do not use quoting characters within filenames.
Also, please do not end a filename with a dot, as NT
cannot deal with this. Finally, do not use leading
or trailing spaces. Your name was (X = illegal):
$elname
EOT
if ($ENV{CCASE_NO_CLEARPROMPT}) {
print STDERR $prompt;
} else {
clearprompt(qw(proceed -type error -default abort -mask abort -promt),
$prompt);
}
exit 1;
}
$dirname = $elname;
$elname =~ s,.*/,,;
$dirname =~ s,[^/]*$,.,;
@vlist = grep(!m,/\d+$,, ctqx(qw(lsvtree -short), $dirname));
# OK, now look in each branch of this directory for the file element to
# be created; display info on error.
$found = '';
%seen = ();
unless (-d $dirname.$ENV{CLEARCASE_XN_SFX}.'/main') {
# snapshot view
SNAP_VERSION:
foreach (@vlist) {
chomp;
if (m,/CHECKEDOUT$,) {
# Multiple (unreserved) checkouts appear multiple times
next SNAP_VERSION if $seen{$_};
$seen{$_}++;
($xpn = $_) =~ s,CHECKEDOUT$,,;
# unreserved checkouts - there can be several...
foreach (grep(m,/CHECKEDOUT\.\d+$, , ctqx(qw(ls -short), $xpn))) {
chomp;
unless (ctsystem({stdout => 0, stderr => 0}, qw(ls -d), "$_/$elname")) {
$found = "$_/$elname";
last SNAP_VERSION;
}
}
} else {
# only check the LATEST in a non-checkout branch
unless (ctsystem({stdout => 0, stderr => 0}, qw(ls -d), "$_/LATEST/$elname")) {
$found = "$_/LATEST/$elname";
last SNAP_VERSION;
}
}
}
} else {
# dynamic view
DYN_VERSION:
foreach (@vlist) {
chomp;
if (m,/CHECKEDOUT$,) {
# Multiple (unreserved) checkouts appear multiple times
next DYN_VERSION if $seen{$_};
$seen{$_}++;
($xpn = $_) =~ s,CHECKEDOUT$,,;
# unreserved checkouts - there can be several...
foreach (grep(m,/CHECKEDOUT\.\d+$, , ctqx(qw(ls -short), $xpn))) {
chomp;
if (-d "$_/$elname") {
$found = "$_/$elname";
last DYN_VERSION;
}
}
} else {
# only check the LATEST in a non-checkout branch
if (-d "$_/LATEST/$elname") {
$found = "$_/LATEST/$elname";
last DYN_VERSION;
}
}
}
}
# Nothing; go ahead.
#
exit 0 unless $found;
$prompt = <<EOT;
ERROR: An element named "$elname" already exists in
in some other version of "$dirname":
Instead of creating a new element, you probably want to
create a hard link to the existing element, like so:
% cleartool ln $found .
EOT
if ($ENV{CCASE_NO_CLEARPROMPT}) {
print STDERR $prompt;
} else {
clearprompt(qw(proceed -type error -default abort -mask abort -prompt),
$prompt);
}
exit 1;