Files
SauvegardePST/Perl/bin/reloc_perl
2025-08-27 09:03:01 +02:00

188 lines
4.9 KiB
Perl

#!perl -w
use strict;
use ActiveState::RelocateTree qw(relocate spongedir rel2abs);
use Config;
use File::Basename qw(dirname);
use Getopt::Std;
use vars qw(
$opt_a $opt_b $opt_d $opt_e $opt_f $opt_i $opt_t $opt_r $opt_v
*OLDERR
);
my $logname;
BEGIN {
# If we're being run via wperl, redirect the output streams to a log file.
if ($^O eq 'MSWin32' and $^X =~ /\bwperl(.exe)?\z/i) {
my $tmp = $ENV{TEMP} || $ENV{tmp} || "$ENV{SystemDrive}/" || "c:/temp";
$logname = "$tmp/ActivePerlInstall.log";
open(STDERR, ">> $logname");
open(STDOUT, ">&STDERR");
}
}
my $frompath_default = $Config{prefix};
getopts('abde:f:itrv') or usage('');
my $topath = shift || usage('');
my $frompath = shift || $frompath_default;
if ($topath eq "~") {
$topath = dirname(dirname($^X));
}
# MSI insists on handing us paths with backslashes at the end
if ($^O eq 'MSWin32') {
$topath =~ s{\\\z}{};
$frompath =~ s{\\\z}{};
}
my $destpath = $opt_e || $topath;
my $filelist = $opt_f || '';
usage("$destpath is longer than $frompath")
if length($destpath) > length($frompath) and ! $opt_a;
usage("$destpath is longer than " . spongedir('thisperl'))
if length($destpath) > length(spongedir('thisperl')) and ! $opt_t;
if (-d $topath) {
if (not -d $frompath) {
#warn "Will do inplace edit of `$topath'\n";
$opt_i++;
}
}
elsif ($opt_i) {
usage("Directory `$topath' doesn't exist, can't do inplace edit");
}
sub usage {
(my $progname = $0) =~ s,.*[\\/],,;
my $msg = shift || "";
print STDERR <<EOT;
$msg
Usage: $progname [options] topath [frompath]
Recognized options:
-a allow topath to be longer than frompath
-b don't delete backups after edit
-d delete source tree after relocation
-e path edit files to contain this path instead of topath
-f logfile write log of the modified files
-i edit perl installation at topath in-place
-t only edit text files
-r do not run ranlib on *.a files that were edited
-v turn on verbosity
The frompath defaults to '$frompath_default'.
Run 'perldoc $progname' for further information.
EOT
exit(1);
}
relocate(
to => $topath,
from => $frompath,
replace => $destpath,
verbose => $opt_v,
filelist => $filelist,
ranlib => (not $opt_r),
textonly => $opt_t,
savebaks => $opt_b,
inplace => $opt_i,
killorig => $opt_d,
usenlink => 0, # don't use nlink: broken on HP-UX.
);
__END__
=head1 NAME
reloc_perl - copy a perl installation to a new location
=head1 SYNOPSIS
reloc_perl [-a] [-b] [-d] [-e path] [-f file] [-i] [-t] [-r] [-v]
topath [frompath]
=head1 DESCRIPTION
The B<reloc_perl> program will copy a perl installation wholesale to a
new location. During the copy it edits path names in the copied files
to reflect the new location.
The I<topath> is the file system location where the perl installation
should be copied to. This location should normally not already
exists. A directory will be created at I<topath> and then populated
with the F<bin>, F<lib>, F<html> and F<man> directories of the perl
installation.
The perl installation copied is the one where B<reloc_perl> itself
resides, but this can be overridden by providing a I<frompath>.
Running B<reloc_perl> without arguments will show what this path is,
as well as a short usage message.
=head1 OPTIONS
The following options are recognized by the C<reloc_perl> program:
=over 5
=item B<-a>
The B<reloc_perl> program will refuse to copy if I<topath> is longer
than I<frompath>. This option overrides this restriction. The
I<topath> must still be shorter than the path built into the perl
binary.
=item B<-b>
Don't delete the backups created during the edits performed in I<topath>.
=item B<-d>
Delete the perl installation that was copied. Use with care!
=item B<-e> I<path>
Edit files to contain this path instead of the I<topath>. This allow
relocation to a different location than where the files themselves are
copied.
=item B<-f> I<logfile>
Creates I<logfile> and writes the full path name of
each file that was modified (one line per file).
=item B<-i>
Edit perl installation at I<topath> in-place. Makes no attempt to
move tree and the B<-d> is ignored. This option is assumed if
I<topath> exists, is a directory, and I<frompath> doesn't exist.
=item B<-t>
Only edit the text files. When this option is used, the restriction
that I<topath> must not be longer than I<frompath> is relaxed.
=item B<-r>
Do not run F<ranlib> any F<*.a> files that were edited.
=item B<-v>
Print a trace of what's going on.
=back
=head1 SEE ALSO
L<ActiveState::RelocateTree>
=head1 COPYRIGHT
Copyright 1999-2001 ActiveState Software Inc. All rights reserved.
=cut