@rem= 'WINDOWS users: ccperl must be in your search path
@rem=  (ccperl is the clearcase-shipped perl interpreter)
@echo off
ccperl -w -e "$h=q{%0};if(substr($h,0,1)eq q{\\}){$p=`cd`;$h=substr($p,0,2).$h}foreach(\"\",split(/;/,$ENV{PATH})){s,(.)$,$1/,;if (-f \"$_$h\"){do \"$_$h\";last};if (-f \"$_$h.bat\"){do \"$_$h.bat\";last}}" -- %*
goto end_of_perl
@rem ';
@rem =""; # avoid "main::rem" used only once
#!/usr/bin/perl
##########################################################################
#
# Copyright (C) 2004,2005 Thomas Schuett, www.tschuett.de
#
# Purpose: Sets an extended ClearCase(tm) config spec
#
# Description: See at the end of the file or use perldoc
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details,
# available from http://www.gnu.org/copyleft/gpl.html
#
# Clearcase is a trademark of Atria, then Rational and now IBM.
# 
##########################################################################
#------------  start of perl script -----------------

my $version = "0.641";

if (! @ARGV) {
   print "Usage: setxcs [-batch] <extended_configspec>\n";
   print "  or : setxcs -h|-help\n";
   print "  or : setxcs -v|-version\n";
   exit 1;
}

if (($ARGV[0] eq "-v") || ($ARGV[0] eq "-version")) {
   print "setxcs, version: $version\n";
   exit 1;
}

if (($ARGV[0] eq "-h") || ($ARGV[0] eq "-help")) {
   print "Please use \"perldoc setxcs\"\n";
   exit 1;
}

if ($ARGV[0] eq "-batch") {
   $batchmode = 1;
   shift @ARGV;
}

if (! @ARGV) {
   myExit ("Error: No config spec given.\n");
}

##################### main start ################################

$only_set_once = 0;       # to switch of the set-again feature
$auto_set_again_max = 8;  # only needed for batch mode

$set_count = 1;
$orig_dir = &getpwd;
if (! &isViewSelected) { &change_into_ccdir; }
$cc_dir   = &getpwd;  # may be the same as $orig_dir, but probably it is not.
# Warning: global var $cc_dir is used in parse_xcs too as an additional 
#          try to resolve include pathes.

chdir $orig_dir;
get_resulting_configspec($ARGV[0]);  # globals: $res, $vars , $files_involved

SET_AGAIN:
chdir $cc_dir;
set_resulting_configspec($res);
$set_count++;

$files_involved_before = $files_involved;

exit if $only_set_once;

chdir $orig_dir;
get_resulting_configspec($ARGV[0]);  # globals: $res, $vars , $files_involved

if ($files_involved_before ne $files_involved) {
   if (($batchmode) && ($set_count - 1 < $auto_set_again_max)) { goto SET_AGAIN; }
   if ($batchmode) { myExit("auto_set_again_max reached, still not stable."); }
   if (&askfor_set_again($files_involved_before,$files_involved)) { goto SET_AGAIN; }
}

exit 0;

##################### main end ################################


#-----------------------------------------------------------------

sub myExit
{
   print "\n",shift;
   if ((&isWindows) && (! $batchmode)) {  # quick hack, actually only if started with double-click
      print "(Press RETURN to continue.)\n";
      $in = <STDIN>;
   }
   exit 1;
}

sub isWindows
{
   if (-d "c:\\") { return 1; }  # any better idea?
   return 0;
}

sub getpwd
{
   # no perl function found!?
   my @r = ();
   if (&isWindows) { @r = `cd`;  }
   else            { @r = `pwd`; }
   my $ret = $r[0];
   $ret =~ tr/\012\015//d;
   return $ret;
}


sub isViewSelected
{
   my $view = `cleartool pwv -short`;
   $view =~ tr/\012\015//d;
   if ($view eq "** NONE **") { return 0; }
   return 1;
}


sub isFileInVOBdir
{
   my $fname = shift;

   # what comes now looks very wired, but I found no way
   # to do a "cleartool ls" without getting an error message in case that the
   # file is outside of a vob.
   my $startpwd = &getpwd;
   my $filedir = $fname;
   $filedir =~ s,\\,/,g;
   $filedir =~ s,/[^/]*$,,;
   chdir $filedir;
   my @r = `cleartool pwv`;
   chdir $startpwd;
   foreach (@r) {
      if ( /Working directory view: .. NONE ../ ) { return 0; }
   }
   return 1;
}


sub change_into_ccdir
{
   print "You are not in a clearcase directory\n";
   print "Please enter the path to the view (e.g. Z:): ";
   my $in = <STDIN>;
   $in =~ tr/\012\015//d;
   if ($in =~ /^[a-z]:$/i ) {
      $in .= "/"; # one of those dos "specials", needed for $fname_tmp4
   }
   chdir ($in);
   if (! &isViewSelected) {
      myExit ("Error: No view found under $in\n");
   }
}


sub set_resulting_configspec
{
   my $res = shift;
   
   my $tmpdir = "C:/temp/";
   if (! -d $tmpdir) { $tmpdir = "C:/temp/"; }
   if (! -d $tmpdir) { $tmpdir = "C:/tmp/"; }
   if (! -d $tmpdir) { $tmpdir = "C:/"; }
   if (! -d $tmpdir) { $tmpdir = "/tmp/"; }
   if (! -d $tmpdir) { $tmpdir = ""; }
   my $pid = $$; $pid =~ tr/0-9//cd;
   $tmpcs = "${tmpdir}tmp_cs.$pid";
   open(F,">$tmpcs") || myExit ("Can't open \"$tmpcs\": $!\n");
   print F $res;
   close F;
   `cleartool setcs $tmpcs`;
   unlink $tmpcs;
   if ($? != 0) {
      print "================= parsed config spec: =====================\n";
      my $nr = 1;
      foreach (split(/\n/,$res)) {
         printf "%3d:  %s\n",$nr,$_;
         $nr++;
      } 
      print "===========================================================\n";
      myExit ("Errors: Please see above.\n");
   }
}


sub askfor_set_again
{
   my $files_involved_before = shift;
   my $files_involved_now    = shift;
   
   my $CR = "\n";
   
   my $text = "INFO: Version of visible config spec or include files has changed!$CR$CR"; 
   $text .= "Files used to set the config spec:$CR";
   $text .= $files_involved_before;
   $text .= "${CR}Files visible and needed now:$CR";
   $text .= "$files_involved_now$CR";
   $question = "Shall I set the config spec again? [y/n] ";

   # clearprompt too buggy (cuts of parts of the message at all sides)
   #system("clearprompt yes_no -type warning -mask \"yes\",\"no\" -prompt \"$text\" -newline");

   print "$CR$text";
   ASKAGAIN:
   print "$question";
   $in = <STDIN>;

   $in =~ tr/A-Z/a-z/;
   $in =~ tr/\012\015//d;
   if ($in eq "y")   { return 1; }
   if ($in eq "yes") { return 1; }
   if ($in eq "n")   { return 0; }
   if ($in eq "no")  { return 0; }
   goto ASKAGAIN;
}


sub get_resulting_configspec
{
   my $cs_name = shift;

   $res            = "";
   $files_involved = "";
   %files_involved = ();
   %vars           = ();

   # initialise internal variables
   $vars->{globs}->{XCS_INCLUDEINFO} = "yes";
   $vars->{globs}->{XCS_INCLUDEBASE} = "";

   
   $res  = "# This config spec was preparsed with setxcs. Instead of\n";
   $res .= "# editing this config spec directly you should consider\n";
   $res .= "# editing the extended config spec input file.\n# Input file used: ";
   $res .= $ARGV[0]."\n# Parsed at: ".localtime(time);
   $res .= " (${set_count}x parsed)" if $set_count > 1;
   $res .= "\n\n";
   parse_xcs($cs_name);  # globals: $res, $vars , $files_involved

   ##
   ## beautify the parse result (many empty lines to one, no  leading spaces at all)
   ##
   $res =~ s,^[\t ]+,,gm;
   $res =~ s,[\t ]+##[\t ].*,,gm;  # delete xcs comments
   $res =~ s,^##[\t ].*,,gm;       # delete xcs comments
   $res =~ s,\n\n\n,\n\n,gm;
   $res =~ s,\n\n\n,\n\n,gm;
   $res =~ s,\n\n\n,\n\n,gm;
   
   foreach (sort keys %files_involved) {
      $files_involved .= "   $_";
   }
}


sub parse_xcs
{
   local $fname = shift;
   
   my $fname_tmp1 = "";
   my $fname_tmp2 = "";
   my $fname_tmp3 = "";
   my $fname_tmp4 = "";
   
   $fname_tmp1 = $fname;
   $fname_tmp2 = getval("XCS_INCLUDEBASE") . $fname;
   $fname_tmp3 = $ENV{"XCS_INCLUDEBASE"}   . $fname if $ENV{"XCS_INCLUDEBASE"};
   $fname_tmp4 = $cc_dir . "/" . $fname;
   
   $fname_tmp2 = "" if (! -r $fname_tmp2);
   $fname_tmp3 = "" if (! -r $fname_tmp3);
   $fname_tmp4 = "" if (! -r $fname_tmp4);
   
   $fname = $fname_tmp2 || $fname_tmp3 || $fname_tmp4 ||$fname_tmp1;

   if ((! -r $fname) || (! -s $fname)) {
      my $text = "Error: Config spec or include file not readable or empty.\n";
      $text   .= "Filename: $fname\n";
      $text   .= "Probably you forgot to set a good XCS_INCLUDEBASE ?\n";
      myExit ($text);
   }

   if (isFileInVOBdir($fname)) {
      my @r = `cleartool ls -short "$fname"`;
      $files_involved{$r[0]}    = 1;
   }
   else { 
      $files_involved{"$fname"} = 1; 
   }
   
   open(F,$fname);
   my @cs=<F>;
   close F;


   my $skiplines = 0;
   foreach $line (@cs) {
      if ($line =~ /^\s*end-if\s*/) { $skiplines = 0; next; }
      next if $skiplines;
         
      foreach (keys %{$vars->{globs}},keys %{$vars->{$fname}}) {
         $val = getval($_);
         $line =~ s,\$$_\b,$val,g;
      }

      if ($line =~ /^\s*(\S+)\s*=\s*\"([^\"]*)\"\s*/) {
         ($n,$v) = ($1,$2);
         if    (substr($n,0,4) eq "XCS_") { $vars->{globs}->{$n} = $v;}
         elsif (substr($n,0,1) eq "_")    { $vars->{globs}->{$n} = $v;}
         else { $vars->{$fname}->{$n} = $v; }
         next;
      }
      elsif ($line =~ /^\s*(\S+)\s*=\s*(\S+)\s*/) {
         ($n,$v) = ($1,$2);
         if    (substr($n,0,4) eq "XCS_") { $vars->{globs}->{$n} = $v;}
         elsif (substr($n,0,1) eq "_")    { $vars->{globs}->{$n} = $v;}
         else { $vars->{$fname}->{$n} = $v; }
         next;
      }

      if ($line =~ /^\s*if\-defined\s+(\S+)\s*/) {
         if (! getboolval($1)) { $skiplines = 1; }
         next;
      }

      if ($line =~ /^\s*if\-not\-defined\s+(\S+)\s*/) {
         if (getboolval($1)) { $skiplines = 1; }
         next;
      }

      if ($line =~ /^\s*include\s+(\S+)\s*/) {
         $incfile = $1;
         $res .= "### include $incfile\n"     if getboolval("XCS_INCLUDEINFO");
         parse_xcs($incfile);
         $res .= "### end include $incfile\n" if getboolval("XCS_INCLUDEINFO");
         next;
      }
      
      $res .= "$line";
   }
   $res .= "\n";

   if (0) {
   foreach (keys %{$vars->{$fname}}) {
      print "$_ : ".$vars->{$fname}->{$_}."\n";
   }
   foreach (keys %{$vars->{globs}}) {
      print "$_ : ".$vars->{globs}->{$_}."\n";
   }
   }
}

sub getval
{ my $v = shift;
   if (substr($v,0,1) eq "_")    { return $vars->{globs}->{$v}};
   if (substr($v,0,4) eq "XCS_") { return $vars->{globs}->{$v}};
   return $vars->{$fname}->{$v};
}
   
sub getboolval
{ my $v = shift;
   $v = getval($v);
   if (! $v)          { return 0; }
   if ($v eq "no")    { return 0; }
   if ($v eq "false") { return 0; }
   return 1;
}

#------------  end of perl script -----------------
exit
__END__


=head1 NAME

setxcs - set an extended clearcase config spec
         which can have variables, if-defined statements and more

=head1 SYNOPSIS

 setxcs -version
 setxcs [-batch] <name_of_extended_configspec>
 
=head1 README

  setxcs allows you to use variables, if-defined statements and 
  other goodies inside a ClearCase config spec. It pre-parses
  such an extended config spec, evaluates the extras, and feeds the 
  result into a "cleartool setcs" command.
  
  It is tested on UNIX and WINDOWS platforms.    

=head1 DESCRIPTION

 setxcs sets an extended ClearCase config spec. 
 
 If the current working directory is not a clearcase directory, you will 
 get prompted for the path to the view to set this config spec for.
 
 If the used config spec or any included file (which may be versioned files) 
 is visible in a different version after setting the config spec, you will get 
 prompted and asked, if the config spec should be set again.
 
 Additional available elements in the config spec:
 
    varname = value    : You can set a variable. If you set the same
                         variable again, it just will have the newer value
                         for all succeeding uses. The default variable scope
                         is the file, where it is used.

                         When surounding the value with ""-signs, the value can
                         include spaces. 
                         Example:  base = "/main/LATEST -time 15-Oct"

    _varname = value   : If a variable starts with an _ then it is a global 
                         variable. This means that it is available in included
                         extended config specs too.
                         Warning: Global variables may get changed inside 
                         of included extended config specs.

    $varname           : Will be replaced by the content of varname.

    include filename   : Includes the named file. This means, that in contrast
                         to the standard clearcase include, a later "catcs" 
                         will show you the content of the include file, and not 
                         only its name. Also now you are allowed to add a comment
                         at the end of the line. "filename" can be a variable.
                         Please also read section "special variables"!
 
    if-defined varname : The following lines will only be included, if
       ...               the named variable is set with any string 
                         besides "0", "no" or "false".
    end-if               If-Statements can NOT BE NESTED!  
    
    if-not-defined varname : Guess what.
       ...             
    end-if
    
    ##                 : (A double-# surrounded by spaces, or a line 
                         starting with "## ".) 
                         Such comments will not appear in the parsed config spec
                         (so it will not be visible with "cleartool catcs", after
                         this extended config spec was set).
                         
 Special variables (can be set inside a xcs):
    XCS_INCLUDEBASE    : Is preceded to all used include files. If the include file 
                         can not be found, the *environment* variable XCS_INCLUDEBASE
                         is preceded for a 2nd try. If the include file still can not 
                         be found, a 3th try is done without any precedings.
                         
    XCS_INCLUDEINFO    : Can be set to "yes" or to "no". If set to yes (=default),
                         all file includes are surrounded with an starting and ending
                         info comment in the resulting config spec. 


 Calling parameters:
    -version           : Prints a version info and exits.
    -batch             : No interactive questions. Auto-set-again until $auto_set_again_max


 Debug mode:
    debug (or foo)     : If you have a single word like xxx in any line, this will create
                         an error, when it gets feed to the "cleartool setcs" command.
                         As an result, setxcs will show you the ClearCase error message
                         followed by its xcs parsing result. Just try it.


=head1 FURTHER PLANS

 - fix the problem described under "KNOWN BUGS"
 - if-statements can be nested
 - XCS_LATEST_TIME for automatically extend each LATEST label by a time line
 
=head1 KNOWN BUGS

  If the set-again feature is enabled (=default) and a file needed for
  setting again is not visible (or only visible with zero size) at the
  2nd try, the error message will not point out in any way, that the 
  parsing error occured at the 2nd try.
  

=head1 INSTALLATION INSTRUCTIONS

  Usage with Windows/Command line:
     1. (First time only:) Save setxcs.bat in the search path, e.g. in C:\winnt
     2. In the DOS shell, say:  setxcs <cs_name.xcs>

  Usage with Windows, double-click in Explorer
      1. (First time only:) Create a assosiation for extension ".xcs" to this program
      2. To set an extended config spec, just double-click on it.

  Usage with Unix/Command line:
     1. (First time only:) Do "dos2unix setxcs.bat > setxcs". Then store setxcs in the 
         search path, delete everything up to the "#!" and set exec permissions. 
         If in csh/bash, do an "refresh" then.
     2. In the command shell, say:  setxcs <cs_name.xcs>

=head1 AUTHOR

  I would be very happy to know, if this script is being used somewhere.
  If so, please send a short mail to perl@tschuett.de just to make me happy.
  
=pod SCRIPT CATEGORIES

  VersionControl/ClearCase
   
=cut
:end_of_perl