home *** CD-ROM | disk | FTP | other *** search
/ PC World 2003 March / PCWorld_2003-03_cd.bin / Software / Topware / activeperl / ActivePerl / Perl / bin / reloc_perl.bat < prev    next >
Encoding:
DOS Batch File  |  2002-12-01  |  4.2 KB  |  154 lines
  1. @rem = '--*-Perl-*--
  2. @echo off
  3. if "%OS%" == "Windows_NT" goto WinNT
  4. perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
  5. goto endofperl
  6. :WinNT
  7. perl -x -S %0 %*
  8. if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
  9. if %errorlevel% == 9009 echo You do not have Perl in your PATH.
  10. if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
  11. goto endofperl
  12. @rem ';
  13. #!perl -w
  14. #line 15
  15.  
  16. use strict;
  17. use ActiveState::RelocateTree qw(relocate spongedir rel2abs);
  18. use Config;
  19. use Getopt::Std;
  20. use vars qw(
  21.     $opt_a $opt_b $opt_d $opt_e $opt_f $opt_i $opt_t $opt_r $opt_v
  22.     *OLDERR
  23. );
  24.  
  25. my $logname;
  26.  
  27. BEGIN {
  28.     # If we're being run via wperl, redirect the output streams to a log file.
  29.     if ($^O eq 'MSWin32' and $^X =~ /\bwperl(.exe)?\z/i) {
  30.     my $tmp = $ENV{TEMP} || $ENV{tmp} || "$ENV{SystemDrive}/" || "c:/temp";
  31.     $logname = "$tmp/ActivePerlInstall.log";
  32.     open(STDERR, ">> $logname");
  33.     open(STDOUT, ">&STDERR");
  34.     }
  35. }
  36.  
  37. my $frompath_default = $Config{prefix};
  38.  
  39. getopts('abde:f:itrv') or usage('');
  40.  
  41. my $topath      = shift || usage('');
  42. my $frompath    = shift || $frompath_default;
  43. # MSI insists on handing us paths with backslashes at the end
  44. if ($^O eq 'MSWin32') {
  45.     $topath =~ s{\\\z}{};
  46.     $frompath =~ s{\\\z}{};
  47. }
  48. my $destpath    = $opt_e || $topath;
  49. my $filelist    = $opt_f || '';
  50.  
  51. usage("$destpath is longer than $frompath")
  52.     if length($destpath) > length($frompath) and ! $opt_a;
  53. usage("$destpath is longer than " . spongedir('thisperl'))
  54.     if length($destpath) > length(spongedir('thisperl')) and ! $opt_t;
  55.  
  56. if (-d $topath) {
  57.     if (not -d $frompath) {
  58.     #warn "Will do inplace edit of `$topath'\n";
  59.     $opt_i++;
  60.     }
  61. }
  62. elsif ($opt_i) {
  63.     usage("Directory `$topath' doesn't exist, can't do inplace edit");
  64. }
  65.  
  66. sub usage {
  67.     my $msg = shift;
  68.     warn <<EOT;
  69.     $msg
  70.     Usage:
  71.         $0 [-a] [-b] [-d] [-e destpath] [-f logfile] [-i] [-t] [-r] [-v]
  72.            topath [frompath]
  73.  
  74.         -a              allow destpath to be longer than frompath
  75.         -b              don't delete backups after edit
  76.         -d              delete source tree after relocation
  77.         -e destpath     edit files to contain this path instead of `frompath'
  78.                           (defaults to `topath')
  79.         -f logfile      creates `logfile' and writes the full path name of
  80.                           each file that was modified (one line per file)
  81.         -i              edit perl installation at `topath' insitu
  82.                           (makes no attempt to move tree, -d is ignored)
  83.         -t              only edit text files
  84.         -r              do not run `ranlib' on *.a files that were edited
  85.         -v              verbose messages
  86.  
  87.     'destpath' defaults to `topath'
  88.  
  89.     'frompath' defaults to '$frompath_default'
  90.  
  91.     'destpath' must be shorter than 'frompath' unless the -a option is
  92.     specified.
  93.  
  94.     'destpath' must shorter than the path built into this Perl binary,
  95.     unless the -t option is given. The -a switch cannot override this
  96.     restriction.
  97.  
  98.     -i is assumed if `topath' exists, is a directory, and `frompath'
  99.     doesn't exist.
  100. EOT
  101.     exit(1);
  102. }
  103.  
  104. relocate(
  105.     to        => $topath,
  106.     from    => $frompath,
  107.     replace    => $destpath,
  108.     verbose    => $opt_v,
  109.     filelist    => $filelist,
  110.     ranlib    => (not $opt_r),
  111.     textonly    => $opt_t,
  112.     savebaks    => $opt_b,
  113.     inplace    => $opt_i,
  114.     killorig    => $opt_d,
  115.     usenlink    => 0, # don't use nlink: broken on HP-UX.
  116. );
  117.  
  118. __END__
  119.  
  120. =head1 NAME
  121.  
  122. reloc_perl - relocate a perl installation
  123.  
  124. =head1 SYNOPSIS
  125.  
  126.   reloc_perl [-a] [-b] [-d] [-e destpath] [-f file] [-i] [-t] [-r] [-v]
  127.              topath [frompath]
  128.  
  129. =head1 DESCRIPTION
  130.  
  131. This tool will move a perl installation wholesale to a new location.
  132.  
  133. Edits path names in binaries (e.g., a2p, perl, libperl.a) to reflect the
  134. new location, but preserves the size of strings by null padding them as
  135. necessary.
  136.  
  137. Edits text files by simple substitution.
  138.  
  139. 'destpath' cannot be longer than 'frompath'.
  140.  
  141. If 'frompath' is not found in any files, no changes whatsoever are made.
  142.  
  143. Running the tool without arguments provides more help.
  144.  
  145. =head1 COPYRIGHT
  146.  
  147. (c) 1999-2001 ActiveState Tool Corp.  All rights reserved.
  148.  
  149. =cut
  150.  
  151.  
  152. __END__
  153. :endofperl
  154.