@rem = '--*-Perl-*--';
@rem = '
@echo off
rem
rem  CTC++ Wrapper for Windows
rem ==========================
rem
rem Some, but not all, sanity checks...
if "%CTCHOME%" == "" goto NoCTCHOME
if not exist "%CTCHOME%\Perl\perl.exe" goto NoPERL
if "%OS%"=="Windows_NT" goto WinNT
echo *** ctcwrap requires Windows Vista or higher
echo *** run aborted
goto end
:WinNT
rem Do the work in Perl...
"%CTCHOME%\Perl\perl" %~sf0 %*
if errorlevel 1 exit /B 1
goto End
@rem ';
##########################################################################
# CTC++ Wrapper for Windows. Handling of ctcwrap command.
#
# Copyright (c) Verifysoft Technology GmbH
##########################################################################

sub parse_command_line;
sub safeguarded_argument;
sub generate_module_info;

sub set_onoff_ide;
sub set_mode_on;
sub set_mode_off;
sub copy_ctcagents;
sub delete_ctcagents;
sub get_wrapped_commands;

sub set_onoff_hard_cmdl;
sub set_onoff_hard_ide;
sub set_absagents;
sub copy_absagents;
sub delete_absagents;

sub which;
sub get_dll;
sub basename;
sub dirname;

##########################################################################
# global "constants"
##########################################################################
$ctcwrap = "ctcwrap";
$version = "v9.1.4.1";

$help =<<END;
$ctcwrap - CTC++ Wrapper for Windows ($version)

Usage:
  $ctcwrap [ctc-options] command [arguments]
  $ctcwrap -h

Makes a "ctc-build": The 'command arguments' is started. If its execution
calls C/C++ compile/link commands, they are prepended with 'ctc ctc-options'.

examples:
  $ctcwrap -i f -v nmake -f mymakefile.mak
  $ctcwrap mybuildscript.bat
  $ctcwrap -i m devenv myproject.vcproj /rebuild debug
  $ctcwrap -i m -C "EXCLUDE+*\\prj3dir\\*" devenv mysolut.sln /build release

END

##########################################################################
# global variables
##########################################################################
@ctcopts = ();
$ctcopts = "";
@cmd = ();
@compilers = ();
$modeon_info = "";
$verbose = 0;
%wrapper = ();
$ret = 0;

##########################################################################
# execution starts here !
##########################################################################

# Handle the "ctcwrap [-h]" case...
if ((@ARGV == 0) or (@ARGV == 1 and ($ARGV[0] eq "-h"))) {
   print $help;
   exit(0);
}

# Sanity check about the environment...
if (!defined $ENV{'TEMP'} && !defined $ENV{'CTCWRAPDIR_ROOT'}) {
   die "*** $ctcwrap error: Env. variable TEMP or CTCWRAPDIR_ROOT must be defined.\n";
}

# Sanity checks when internal -ide call case
if (@ARGV >= 1 and $ARGV[0] eq "-ide") {
   if (@ARGV == 1) {
      die "*** $ctcwrap error: Mode on/off option required.\n" .
          "    Bad internal use of -ide.\n";
   } elsif ($ARGV[1] ne "-modeon" and $ARGV[1] ne "-modeoff") {
      die "*** $ctcwrap error: Invalid mode on/off option.\n" .
          "    Bad internal use of -ide.\n";
   } elsif (@ARGV > 2) {
      die "*** $ctcwrap error: Too many options.\n" .
          "    Bad internal use of -ide.\n";
   }
}


# Handle the invalid "ctcwrap -hard" cases...
if (@ARGV >= 1 and $ARGV[0] eq "-hard") {
    if (@ARGV >= 2 and $ARGV[1] eq "-ide") { # Sanity checks when internal -hard -ide call case
        if (@ARGV == 2) {
            die "*** $ctcwrap error: Mode on/off option required.\n" .
                "    Bad internal use of -hard -ide.\n";
        } elsif ($ARGV[2] ne "-modeon" and $ARGV[2] ne "-modeoff") {
            die "*** $ctcwrap error: Invalid mode on/off option.\n" .
                "    Bad internal use of -hard -ide.\n";
        } elsif (@ARGV == 3) {
            die "*** $ctcwrap error: Too few options.\n" .
                "    Bad internal use of -hard -ide.\n";
        }
    } else { # Sanity checks when commandline -hard call case
        if (@ARGV == 1) {
            die "*** $ctcwrap error: Mode on/off option required.\n" .
                "    See %CTCHOME%\\doc\\ctcwrap-hard.txt.\n";
        } elsif ($ARGV[1] ne "-modeon" and $ARGV[1] ne "-modeoff") {
            die "*** $ctcwrap error: Invalid mode on/off option.\n" .
                "    See %CTCHOME%\\doc\\ctcwrap-hard.txt.\n";
        } elsif (@ARGV == 2) {
            die "*** $ctcwrap error: Too few options.\n" .
                "    See %CTCHOME%\\doc\\ctcwrap-hard.txt.\n";
        }
    }
}


# prepare the ctcmodeon.txt file contents, needed here and there
generate_module_info();

# continue the ctcwrap line analysing...
if ((@ARGV == 2) and ($ARGV[0] eq "-ide") and
         ($ARGV[1] eq "-modeon" or $ARGV[1] eq "-modeoff")) {
   # Some CTC++ IDE dialog program is calling
   # Normal user should never use these options from command line
   set_onoff_ide();
}
elsif ($ARGV[0] eq "-hard" and $ARGV[1] eq "-ide" and
         ($ARGV[2] eq "-modeon" or $ARGV[2] eq "-modeoff")) {
   # Some CTC++ IDE dialog program is hard calling
   # Normal user should never use these options from command line
   if ($ARGV[3] eq "-only") {
      my $onoff = $ARGV[2];
      my $compiler_dir = $ARGV[4];

      # Now do the what is needed for ctcmodeon.txt
      if ($onoff eq "-modeon") {
         my $modeon_info_hard = $modeon_info . "Integrated Development Environment, " .
                          "-hard -ide options) in $compiler_dir\n";
         open(MODEON, ">$compiler_dir\\ctcmodeon.txt");
         print MODEON $modeon_info_hard;
         close MODEON;
      } else { # -modeoff
         if (-f "$compiler_dir\\ctcmodeon.txt") {
            unlink "$compiler_dir\\ctcmodeon.txt";
         }
      }
   } else {
      set_onoff_hard_ide();
   }
}
elsif ($ARGV[0] eq "-hard" and
         ($ARGV[1] eq "-modeon" or $ARGV[1] eq "-modeoff")) {
   # Hard call from command line
   set_onoff_hard_cmdl();
}
else {
   # 'normal' ctcwrap from command line...

   # Sanity check: ctcwrap must not be called recursively
   if (defined $ENV{'CTCWRAPDIR'} and
       lc(substr($ENV{'CTCWRAPDIR'}, -4)) ne "\\ctc") {
      die "*** $ctcwrap error: This appears to be a recursive call to $ctcwrap.\n" .
          "    (Or CTCWRAPDIR exits but is badly defined, not ending to ...\\ctc)\n" .
          "    Run aborted\n";
   }

   # parse ctc-options, command, and command's options...
   parse_command_line();

   # decide the %TEMP%\ctc<n> or %CTCWRAP_ROOT_DIR%\ctc<n> directory,
   # set %CTCWRAPDIR% to point to it, copy there a proper contents...
   set_mode_on();

   # extend %PATH%...
   $ENV{'PATH'} = $ENV{'CTCWRAPDIR'} . ';' . $ENV{'PATH'};
   # and call the user's command with its arguments...
   my $cnt=0;
   foreach (@cmd) {
       $cnt++ if /^".*"$/;
   }
   if ($cmd[0]=~/^".*"$/ &&
       $cnt>=2) {
       my $cmd='"';
       foreach (@cmd) {
	   $cmd.="$_ ";
       }
       $cmd=~s/\s$/\"/;
       $ret = system($cmd)/256;
   } else {
       $ret = system(@cmd)/256;
   }
   # finally dismantle the used %CTCWRAPDIR%...
   set_mode_off();
   exit($ret);
}

# Execution ends here!
1;


##########################################################################
# SUBROUTINES
##########################################################################

##########################################################################
# SUBROUTINE: parse_command_line
# PURPOSE   : Parses the arguments after 'ctcwrap'.
#             - Extracts ctc-options to @ctcopts.
#             - Extracts the command and its options to @cmd.
##########################################################################
sub parse_command_line
{
   my $i;
   my $addnext = 0;
   my $parse_ctc_args = 1;

   foreach $i (@ARGV) {

      if ($addnext == 1) {
         # we have an argument to a ctc-option... One sanity check...
         if ($i =~ /^-/) {
            # a ctc option argument may not start with '-'. Here we pick
            # away stupid user error like "...-i -C EXCLUDE..."
            die "*** $ctcwrap error: ctc-option argument may not start with '-'.\n" .
                "    Type 'ctcwrap -h' for help.\n";
         }
         push(@ctcopts, safeguarded_argument($i));
         $addnext = 0;

      } elsif ($parse_ctc_args == 1) {
         if ($i eq '-no-templates' ||
            $i eq '-V' ||
            $i eq '-v' ||
            $i eq '-k' ||
            $i eq '-2comp' ||
            $i eq '-no-comp' ||
            $i eq '-no-warnings' ||
            $i eq '-dump-config') {
            # we have an argumentless ctc-option...
            push(@ctcopts, $i);

         } elsif (substr($i, 0, 1) eq '@') {
            # @ctc-responsefile..., also argumentless
            push(@ctcopts, safeguarded_argument($i));

         } elsif ($i eq '-h') {
            # if we have -h here, give help and stop the run...
            print $help;
            exit(0);

         } elsif ($i eq '-c' ||
            $i eq '-C' ||
            $i eq '-n' ||
            $i eq '-i' ) {
           # we have a ctc-option that has one argument...
            push(@ctcopts, $i);
            $addnext = 1;
         }

         # no more ctc-option,
         # start collecting command...
         else {
            # first command argument is handled here, collect...
            push(@cmd, safeguarded_argument($i));
            $parse_ctc_args = 0;
         }
      }
      # these are rest of the command arguments, collect...
      else {
         push(@cmd, safeguarded_argument($i));
      }
   }

   # there must have been some command...
   if ($cmd[0] eq "") {
      die "*** $ctcwrap error: No command to be applied on.\n" .
          "    Type 'ctcwrap -h' for help.\n";
   }
}


##########################################################################
# SUBROUTINE: safeguarded_argument
# PARAMETER : - argument : the argument value as it is seen in ARGV[i]
# PURPOSE   : Cheks if there is a reason to strengthen '"' or '\' chars in
#             the argument (and does so) and should the whole argument be
#             still safeguarded with "..." (and does so).
# RETURNS   : The safeguarded argument. (If no need for safeguarding it
#             is the same value as before)
##########################################################################
sub safeguarded_argument 
{
   my ($arg) = @_;
   my $newarg = "";
   my $quote_needed = 0;
   my $backslash_count = 0;
   my $ch = "";
   my $i = 0;

   # Is there reason to overall "..." safeguarding?
   if ($arg =~ /\s/ or $arg =~ /=/ or $arg =~ /;/ or $arg =~ /,/ or
       $arg =~ /\|/ or $arg =~ /&/ or $arg =~ /</ or $arg =~ />/) {
      $quote_needed = 1;
   }

   # Now start constructing the safeguarded argument.
   # First the starting "... if needed
   if ($quote_needed == 1) {
      $newarg .= '"';
   }

   # Then the $arg chars one by one. Special '\' handling if '"' is met.
   while ($arg ne "") {

      # Extract first char from $arg and reduce it correspondingly
      $arg =~ /^(.)(.*)/;
      $ch = $1;
      $arg = $2; 

      # Copy the char to the safeguarded arg
      if ($ch eq '\\') {
         $backslash_count++;
         $newarg .= '\\';

      } elsif ($ch eq '"') {
         # duplicate the possible preceding backslashes, all of them
         for ($i = 1; $i <= $backslash_count ; $i++) {
            $newarg .= '\\';
         }
         # and the safeguarded '"' still
         $newarg .= '\\' . '"';
         $backslash_count = 0;

      } else {
         # normal/harmless char
         $newarg .= $ch;
         $backslash_count = 0;
      }
   }

   # Finally the closing ..." if needed
   if ($quote_needed == 1) {
      # but here also the possibe preceding backslashes duplicating!
      for ($i = 1; $i <= $backslash_count ; $i++) {
         $newarg .= '\\';
      }
      $newarg .= '"';
   }

   return $newarg;
}


##########################################################################
# SUBROUTINE: set_mode_on
# PURPOSE   : Starting from %CTCWRAPDIR_ROO%\dir1, if it is defined, or if
#             not, starting from  %TEMP%\ctc1 search first free directory
#             where the "ctc-wrapping" could be done. Gives alarm, if
#             there seems to be too many occupied directories already.
#             Sets CTCWRAPDIR env variable to point to it. Handles Symbian
#             specific -rvctxx special options (some special
#             PATH handling...). Copies to selected directory the command
#             agents as advised in wrapcmds.txt. Writes to the directory
#             ctcopts.rsp and ctcmodeon.txt.
##########################################################################
sub set_mode_on
{
   my $ctc_dir;
   my $count = 0;
   my $i;
   my $final_modeon_text;
   my $unique_id;
   my $line;

   srand; # set seed (derived from time()) for 'rand' that is used later...

   # What directory should be as root directory where the \ctc1, \ctc2, etc.
   # directories should be created to or used of?
   if (defined $ENV{'CTCWRAPDIR_ROOT'}) {
      ; # it will be used
   } else {
      $ENV{'CTCWRAPDIR_ROOT'} = $ENV{'TEMP'};  # this env.variable lives only
                                               # during this script!
   }

   # search first free directory...
   while (1) {
      $count++;
      # two sanity checks...
      if ($count == 20) {
         # at this point give alarm that presumably something is wrong...
         print "*** $ctcwrap ALARM**************\n";
         print "Perhaps broken %TEMP% or %CTCWRAPDIR_ROOT%\\ctc1, ctc2, ctc3,...\n";
         print "directories. Please check them and delete if actually not in use.\n";
      }
      if ($count > 100) {
         # at this point give alarm that presumably something is really wrong...
         print "*** $ctcwrap ABORT**************\n";
         print "Perhaps broken %TEMP% or %CTCWRAPDIR_ROOT%\\ctc1, ctc2, ctc3,...,ctc100\n";
         print "directories. Please check them and delete if actually not in use.\n";
         print "Now this run was ABORTED.\n";
         exit(1);
      }

      $ctc_dir = $ENV{'CTCWRAPDIR_ROOT'} . "\\ctc" . $count; #try this one...

      if (-e $ctc_dir and not -d $ctc_dir) { #one sanity check...
         die "*** $ctcwrap error: File $ctc_dir exists and is not a directory.\n";
      }
      if (not -e $ctc_dir) { # create the directory if needed and possible...
         mkdir($ctc_dir, 0755);
      }

      if (not -e $ctc_dir . "\\ctcmodeon.txt") {
         #directory seems to be free, so try to reserve it
         $unique_id = int(rand 1000000000) + 1;
         $final_modeon_info = $modeon_info . "command line, id=" . $unique_id . ")\n";
         open(MODEON, ">$ctc_dir\\ctcmodeon.txt");
         print MODEON $final_modeon_info;
         close MODEON;

         #read the file back and check that it is same as just written,
         #i.e. watch for possible parallel/race-condition use...!
         open(MODEON, "<$ctc_dir\\ctcmodeon.txt");
         $line = <MODEON>; #read one (first and only) line from there
         if ($line ne $final_modeon_info) {
            #some race-writer has won this directory. Try to use some next one
            close MODEON;
         } else {
            # we managed to get a directory to private use!
            close MODEON;
            last; #of the while(1) directory search loop
         }
      }
   }

   # now ready to set %CTCWRAPDIR%
   $ENV{'CTCWRAPDIR'} = $ctc_dir;

   copy_ctcagents();     # load fresh stuff in

   # write the ctc-options to ctcopts.rsp in directory %CTCWRAPDIR%
   open(OPTS, ">$ctc_dir\\ctcopts.rsp");
   foreach $i (@ctcopts) {
      print OPTS " $i";
   }
   print OPTS "\n";
   close OPTS;
}


##########################################################################
# SUBROUTINE: set_mode_off
# PURPOSE   : Deletes ctcagents and ctcmodeon.txt file from the directory
#             that is designated by %CTCWRAPDIR%
##########################################################################
sub set_mode_off
{
   delete_ctcagents();

   if (-f "$ENV{'CTCWRAPDIR'}\\ctcmodeon.txt") {
      unlink "$ENV{'CTCWRAPDIR'}\\ctcmodeon.txt";
   }
}


##########################################################################
# SUBROUTINE: set_onoff_ide
# PURPOSE   : Operates on %CTCWRAPDIR% directory. With argument "-modeon"
#             copies the ctcagents in place and (over)writes the ctcmodeon.txt
#             file. With argument "-modeoff" deletes the ctcagents.
##########################################################################
sub set_onoff_ide
{
   my $ctc_dir = $ENV{'CTCWRAPDIR'};

   if ($ARGV[1] eq "-modeon") {
      # in a very initial ide use you may have to create this directory
      if (-e $ctc_dir and not -d $ctc_dir) {
         die "*** $ctcwrap error: File $ctc_dir exists and is not a directory.\n";
      }
      if (not -e $ctc_dir) {
         mkdir($ctc_dir, 0755);
      }

      copy_ctcagents();

      # we know these IDE's: Visual Studio, CodeWarrior, Carbide.c++, Eclipse, ...
      $modeon_info = $modeon_info . "Integrated Development Environment) in $ctc_dir\n";
      
      # and (over)write the ctcmodeon.txt file
      open(MODEON, ">$ctc_dir\\ctcmodeon.txt");
      print MODEON $modeon_info;
      close MODEON;

   } else { # -modeoff
      delete_ctcagents();

   }
}


##########################################################################
# SUBROUTINE: copy_ctcagents
# PURPOSE   : Copies the ctcagents to %CTCWRAPDIR%
##########################################################################
sub copy_ctcagents
{
   my $index = 0;
   my $agent;

   get_wrapped_commands();

   while ($index < @compilers) {
      my $exe = "ctcagent.ex_";
      if (defined $wrapper{$compilers[$index]}) {
         # alternate agent...
         $exe = $wrapper{$compilers[$index]};
      }
      if (! -f "$ENV{'CTCHOME'}\\$exe") {
         if ($exe !~ /^ctc(java|cs|js)agent.ex_$/) {
            if ($exe eq "ctcagent.ex_") {
               set_mode_off();
               die "*** $ctcwrap error: $ENV{'CTCHOME'}\\$exe does not exist.\n";
            }
            print STDERR "*** $ctcwrap warning: $ENV{'CTCHOME'}\\$exe does not exist.\n";
         } else {
            $exe = "ctcagent.ex_";
         }
      }
      $agent = $ENV{'CTCWRAPDIR'} . "\\" . $compilers[$index];
      $index++;
      system("copy /y $ENV{'CTCHOME'}\\$exe \"$agent\" >NUL");
   }

   # For certain reasons also ctc.exe agent is needed...
   $agent = $ENV{'CTCWRAPDIR'} . "\\ctc.exe";
   system("copy /y $ENV{'CTCHOME'}\\ctcagent.ex_ \"$agent\" >NUL");
}


##########################################################################
# SUBROUTINE: delete_ctcagents
# PURPOSE   : Delete the ctcagents from %CTCWRAPDIR%.
##########################################################################
sub delete_ctcagents
{
   my $index = 0;
   my $agent;

   get_wrapped_commands();

   while ($index < @compilers) {
      $agent = $ENV{'CTCWRAPDIR'} . "\\" . $compilers[$index];
      $index++;
      if (-f $agent) {
         # delete the agent, ctcagent.ex_'s (or alternate agent's) clone...
         unlink "$agent";
      }
   }

   # Remember also the ctc.exe agent...
   $agent = $ENV{'CTCWRAPDIR'} . "\\ctc.exe";
   if (-f $agent) {
      # delete the ctcagent.ex_ clone...
      unlink "$agent";
   }
}


##########################################################################
# SUBROUTINE: get_wrapped_commands
# PURPOSE   : Resolves from %CTCHOME%\wrapcmds.txt the commands to be
#             wrapped. Sets @compilers and %wrapper. Checks that the
#             command has .exe extension.
##########################################################################
sub get_wrapped_commands
{
  my $command;

  open(WRAPCMD, "<$ENV{'CTCHOME'}\\wrapcmds.txt")
     or die "*** $ctcwrap error: Can't open file $ENV{'CTCHOME'}\\wrapcmds.txt for input.\n";

  while (<WRAPCMD>) {
     $command = "";
     if ($_ =~ /^\s*#.*$/ or $_ =~ /^\s*$/) {
        ;                     # comment or empty (whitespace) line
     } elsif ($_ =~ /^\s*(\S+)\s*$/) {
        push @compilers, $1;  # command to be wrapped, uses default wrapper
        $command = $1;
     } elsif ($_ =~ /^\s*(\S+)\s+(\S+)\s*$/) {
        push @compilers, $1;  # command to be wrapped + wrapper
	$wrapper{$1} = $2;    # remember the wrapper here
        $command = $1;
     } else {
        die "*** $ctcwrap error: Bad line in $ENV{'CTCHOME'}\\wrapcmds.txt\n$_.\n";
     }
     if ($command ne "" &&
         !($command =~ /\.exe$/i)) {
        die "*** $ctcwrap error: Wrapped command must have .exe extension " .
            "in $ENV{'CTCHOME'}\\wrapcmds.txt on line\n$_\n";
     }
  }
  close WRAPCMD;
}


##########################################################################
# SUBROUTINE: set_onoff_hard_cmdl
# PURPOSE   : at ctcwrap -hard -modeon <ctc_options> <compiler_list>
#             at ctcwrap -hard -modeoff [-v] <compiler_list>
#             - parses <ctc_options>  (-v only meaningful when -modeoff)
#             - parses <compiler_list> with their abs paths
#             - call to copy or delete absagents
##########################################################################
sub set_onoff_hard_cmdl
{
   my $hard = shift @ARGV;
   my $onoff = shift @ARGV;
   my $arg;
   my $black;

   # Sanity check to not conflict occasionally 
   foreach $arg (@ARGV) {
       # an old relic of some Symbian usage check..., perhaps could be removed?
       foreach $black ("abld", "abld.bat", "sbs", "sbs.bat") {
	   if (lc($arg) eq $black) {
	       die "*** $ctcwrap error: Don't use $arg with $ctcwrap -hard ...\n";
	   }
       }
   }
   
   # parse ctc_options, compiler_list
   parse_command_line();

   # Check for verbose (side-effect: some screen logging in this script)
   foreach (@ctcopts) {
      if ($_ eq '-v') {
         $verbose++;
      }
   }

   set_absagents($onoff, 0); # 0=started from cmdl, 1=started from IDE
}


##########################################################################
# SUBROUTINE: set_onoff_hard_ide
# PURPOSE   : at ctcwrap -hard -ide -modeon <compiler_list>
#             at ctcwrap -hard -ide -modeoff <compiler_list>
#             - parses <compiler_list> with their abs paths
#             - call to copy or delete absagents
##########################################################################
sub set_onoff_hard_ide
{
   my $hard = shift @ARGV;
   my $ide = shift @ARGV;
   my $onoff = shift @ARGV;

   for ($i = 0; $i <= $#ARGV; $i++) {
      push @cmd, $ARGV[$i];
   }

   set_absagents($onoff, 1); # 0=started from cmdl, 1=started from IDE
}


##########################################################################
# SUBROUTINE: set_absagents
# PURPOSE   : at ctcwrap -hard -modeon <ctc_options> <compiler_list>
#             at ctcwrap -hard -ide -modeon <compiler_list>
#             - on each compiler directory
#               -- (over)writes ctcopts.rsp having the <ctc_options> if started from cmdl
#               -- if needed copies copies compiler.exe --> compiler-orig.exe
#               -- copies absagent.ex_ --> compiler.exe
#               -- (over)writes ctcmodeon.txt
#             at ctcwrap -hard -modeoff [-v] <compiler_list>
#             at ctcwrap -hard -ide -modeoff <compiler_list>
#             - on each compiler directory
#               -- copies (with some precautions) compiler-orig.exe --> compiler.exe
#               -- if exists, deletes ctcmodeon.txt
##########################################################################
sub set_absagents
{
   my ($onoff, $ide) = @_; # 0=started from cmdl, 1=started from IDE

   # Check that all the -hard wrappable compilers and linkers are found etc.
   foreach (@cmd) {
       my $tmp = which($_);
       
       if (!defined $tmp) {
          die "*** $ctcwrap error: Can't find $_.\n";
       } 
       if ($tmp =~ /-orig.exe$/) {
          die "*** $ctcwrap error: Use the original name, not -orig.\n";
       }
       push @compilers, $tmp;
       $tmp = get_dll($tmp);
       if (defined $tmp) {
           push @compilers, $tmp;
       }
   }
 
   # Now do the what is needed
   if ($onoff eq "-modeon") {
      if ($ide == 0) {
         copy_absagents(0);
      } else {
         copy_absagents(1);
      }
   } else { # -modeoff
      delete_absagents();
   }
}


##########################################################################
# SUBROUTINE: copy_absagents
# PURPOSE   : To each compiler in its directory
#             - renames COMP.EXE to COMP-orig.EXE (preserves casing as it
#               was in the file system, not how it was given at cmd line),
#               if not yet done
#             - copies the absagent under name COMP.EXE (inherits casing)
#             - writes ctcopts.rsp if started from cmdl
#             - writes ctcmodeon.txt
##########################################################################
sub copy_absagents
{
   my ($ide) = @_; # 0=started from cmdl, 1=started from IDE
   my $index = 0;
   my $orig;
   my $compiler_dir;
   my $modeon_info_hard;
   my $comp = ""; # compiler
   my $realcomp = ""; # compname as in file system
   my $suffix = ""; # .exe / .dll

   if (! -f "$ENV{'CTCHOME'}\\absagent.ex_") {
      die "*** $ctcwrap error: $ENV{'CTCHOME'}\\absagent.ex_ does not exist.\n";
   }

   # done to each compiler directory...
   while ($index < @compilers) {
      # handle compiler...
      $comp = $compilers[$index]; # .\armcc.EXE
      $comp =~ /(.*[\/\\])(.*)/; # get compiler directory
      $compiler_dir = $1;

      if ($comp =~ /\.exe$/i) {
         # has .exe extension, with some case, ok
      } elsif ($comp =~ /\.dll$/i) {
	 # has .dll extension, with some case, ok
      } else {
         # add ".exe", now with lower case
         $comp = $comp . ".exe";
      }
      if (! -f $comp) {
         die "*** $ctcwrap error: compiler '$comp' does not exist";
      }

      if (system("dir \"$comp\" \/b > ctctempfilename.txt")) {
         die "*** $ctcwrap error: dir $comp \/b > ctctempfilename.txt failed";
      }
      open(DIRB, "ctctempfilename.txt");
      $realcomp = <DIRB>;
      chop $realcomp; # armcc.EXe
      $realcomp = $compiler_dir . $realcomp; # .\armcc.EXe
      close DIRB;
      system("del \/q ctctempfilename.txt");
      
      $orig = $realcomp; # .\armcc.EXe
      $realcomp =~ /^(.*)(\.exe|\.dll)$/i;
      $realcomp = $1 . "-orig" . $2; # .\armcc-orig.EXe
      $suffix = $2;
      $suffix =~s/.$/_/;

      if (! -f $realcomp) {
          # only "rename" if not exists (never overwritten by CTC++!!)
          print STDERR "$ctcwrap: ren $orig $realcomp\n" if $verbose;
          if (!rename($orig, $realcomp)) {
              my $dir = dirname($orig);
              $dir = '.' if $dir eq '';
              my $detail = "    We need modification permissions on compiler directory:\n";
              $detail .= "    $dir\n";
              $detail .= "    Please invoke as administrator the following:\n";
              $detail .= "      icacls " . safeguarded_argument($dir) . " /grant " . $ENV{USERNAME} .":M\");\n";
              die "*** $ctcwrap error: Can't rename $orig to $realcomp.\n" . $detail;
          }
      }
      print STDERR "$ctcwrap: copy /y $ENV{'CTCHOME'}\\absagent.ex_ \"$orig\"\n"
          if $verbose;
      system("copy /y $ENV{'CTCHOME'}\\absagent.ex_ \"$orig\" >NUL");
     
      # ctcopts.rsp, ctcmodeon.txt
      if ($ide == 0) {
         open(OPTS, ">$compiler_dir\\ctcopts.rsp");
         foreach $i (@ctcopts) {
            print OPTS " $i";
         }
         print OPTS "\n";
         close OPTS;

         $modeon_info_hard = $modeon_info . "command line, " .
                             "-hard option) in $compiler_dir\n";
      } else {
         # we know these IDE's: uVision, ...
         $modeon_info_hard = $modeon_info . "Integrated Development Environment, " .
                             "-hard -ide options) in $compiler_dir\n";
      }

      open(MODEON, ">$compiler_dir\\ctcmodeon.txt");
      print MODEON $modeon_info_hard;
      close MODEON;
      
      $index++;
   }
}


##########################################################################
# SUBROUTINE: delete_absagents
# PURPOSE   : To each compiler directory
#             - delete the absagents, copy -orig back (inherits casing)
#             - delete ctcmodeon.txt
# NOTE      : We positively don't delete -orig
##########################################################################
sub delete_absagents
{
   my $index = 0;
   my $agent;
   my $size;
   my $compiler_dir;
   my $comp = ""; # compiler
   my $realcomp = ""; # compname as in file system
   my $suffix = "";  # .exe or .dll

   while ($index < @compilers) {
      # handle compiler...
      $comp = $compilers[$index]; # .\armcc.EXE
      $comp =~ /(.*[\/\\])(.*)/; # get compiler directory
      $compiler_dir = $1;
   
      if ($comp =~ /\.exe$/i) {
         # has .exe extension, with some case, ok
      } elsif ($comp =~ /\.dll$/i) {
         # has .dll extension, with some case, ok
      } else {
         # add ".exe", now with lower case
         $comp = $comp . ".exe";
      }
      if (! -f $comp) {
         die "*** $ctcwrap error: compiler '$comp' does not exist";
      }

      $comp =~ /^(.*)(\.exe|\.dll)$/i;
      $comp = $1. "-orig" . $2; # .\armcc-orig.EXE
      $suffix = $2;

      if (system("dir \"$comp\" \/b > ctctempfilename.txt")) {
         die "*** $ctcwrap error: dir $comp \/b > ctctempfilename.txt failed";
      }
      open(DIRB, "ctctempfilename.txt");
      $realcomp = <DIRB>;
      chop $realcomp; # armcc-orig.EXe
      $realcomp = $compiler_dir . $realcomp; # .\armcc-orig.EXe
      close DIRB;
      system("del \/q ctctempfilename.txt");
      
      if ($realcomp =~ /^(.*)-orig(\.exe|\.dll)$/i) { # .\armcc-orig.EXe
         $agent = $1 . $2; # .\armcc.EXe
         if (-f $agent) {
            (undef,undef,undef,undef,undef,undef,undef,$size) = stat($agent);
            if ($size == 65536 ||
               $size == 16384) {    #in case there were old absagent.ex_ ...
               # Sanity check, we only overwrite "our" agent-wrapper absagent.ex_.
               # Size changed in CTC++ v7.3.1-->v74 from 16384--> 65536
               print STDERR "$ctcwrap: copy /y \"$realcomp\" \"$agent\"\n" if $verbose;
               system("copy /y \"$realcomp\" \"$agent\" >NUL");

               # ctcmodeon.txt
               if (-f "$compiler_dir\\ctcmodeon.txt") {
                  unlink "$compiler_dir\\ctcmodeon.txt";
               }
            }
         }
      }
      
      $index++;
   }
}


##########################################################################
# SUBROUTINE: generate_module_info
# PURPOSE   : Construct the begin of the text that will eventually be written
#             to the begin of the ctcmodeon.txt file
##########################################################################
sub generate_module_info
{
   my $time_stamp = "";

   ($sek,$min,$hour,$day,$month,$year,$weekday) = localtime(time);
   $year = 1900+$year;
   $time_stamp =
     (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$weekday] . " " .
     (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$month] . " " .
     $day;

   if ( $hour < 10 ) {
      $time_stamp = $time_stamp . " 0" . $hour . ":";
   } else {
      $time_stamp = $time_stamp . " " . $hour . ":";
   }
   if ( $min < 10 ) {
      $time_stamp = $time_stamp . "0" . $min . ":";
   } else {
      $time_stamp = $time_stamp . $min . ":";
   }
   if ( $sek < 10 ) {
      $time_stamp = $time_stamp . "0" . $sek;
   } else {
      $time_stamp = $time_stamp . $sek;
   }
   $time_stamp = $time_stamp . " " .$year;
   $modeon_info = "CTC++ Mode is ON ($time_stamp from ";
}


##########################################################################
# SUBROUTINE: which 
# PURPOSE   : Determines full path of an executable in $PATH
# ARGUMENTS : - Name of executable
# RETURNS   : Path to executable
##########################################################################
sub which
{
    my ($exe) = @_;
    my $tmp;

    $exe =~ s/^"(.*)"$/$1/;
    unless ($exe =~ /.exe$/i) {
       $exe .= ".exe";
    }

    # if it is like "compiler.exe", which is in current directory (i.e. gets
    # found without PATH help), give back ".\compiler.exe"
    if (!($exe =~ /[\/\\]/)) {
       return "\.\\" . $exe if -x $exe;
    }

    # if it is like compdir\compiler.exe, found without PATH help, give it back.
    return $exe if -x $exe;

    foreach (split ';', $ENV{'PATH'}) {
	$tmp = $_ . '\\' . $exe; 
	return $tmp if -f $tmp;
    }

    return undef;
}

##########################################################################
# SUBROUTINE: get_dll
# PURPOSE   : Checks if wrapping dll needed for CodeWarrior
# ARGUMENTS : - Name of executable
# RETURNS   : Path to .dll if needed, or undef
##########################################################################
sub get_dll
{
    my ($exe) = @_;
    my $dir;
    
    return undef unless -f $ENV{CTCHOME}."\\absagent.dl_";

    if ($exe=~/\.exe$/i) {
	$exe =~s/exe$/dll/i;
	return undef if ! -f $exe; # No dll
	$dir=dirname($exe);
	$dir = Win32::GetCwd() if $dir eq '.';
	if (lc(basename($dir)) eq 'prog') {
	    return $exe;
	}
    }

    return undef;
}

##########################################################################
# SUBROUTINE: basename
# PURPOSE   : Strip directory from a filename
##########################################################################
sub basename 
{
    my ($filename) = @_;
    my $base = $filename;
    my $end;

    $end = rindex $filename, '\\';
    if ((rindex $filename, '/') > $end) {
       $end = rindex $filename, '/';
    }
    if ($end >= 0) {
       $base = substr $filename, $end + 1;
    }
    return $base;
}

##########################################################################
# SUBROUTINE: dirname
# PURPOSE   : Returns the directory part of a filename
##########################################################################
sub dirname
{
    my ($filename) = @_;
    my $dir = "";
    my $end;

    $end = rindex $filename, '\\';
    if ((rindex $filename, '/') > $end) {
       $end = rindex $filename, '/';
    }
    if ($end > 0) {
        $dir = substr $filename, 0, $end;
    } elsif ($end == 0) {
        $dir = substr $filename, 0, 1;
    }
    return $dir;
}


#EOF $RCSfile: ctcwrap.bat $

__END__
:NoCTCHOME
echo.
echo *** Environment variable CTCHOME does not exist. Set the
echo CTCHOME to point to the CTC++ installation directory.
echo.
goto end

:NoPERL
echo.
echo *** CTC++ installation directory %CTCHOME%
echo does not contain Perl subdirectory or it does not contain perl.exe.
echo.
goto end

:end