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