r1 - 02 Sep 2007 - 10:36:13 - MarcGirodCmWiki  >  CM Web  >  Eviltwintrigger
#!/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;
Edit | WYSIWYG | Attach | Printable | Raw View | Backlinks: Web, All Webs | History: r1 | More topic actions | key Log In
 
Copyright © 1998-2008 CM Crossroads LLC
Ideas, requests, problems regarding CmWiki?? Send feedback