302 lines
7.7 KiB
Text
Executable file
302 lines
7.7 KiB
Text
Executable file
:
|
|
eval 'exec perl -S $0 ${1+"$@"}'
|
|
if 0;
|
|
|
|
#*************************************************************************
|
|
#
|
|
# This tool makes it easy to cleanly re-locate a
|
|
# build, eg. after you have copied or moved it to a new
|
|
# path. It tries to re-write all the hard-coded path logic
|
|
# internally.
|
|
#
|
|
#*************************************************************************
|
|
#
|
|
# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
|
|
#
|
|
# Copyright 2000, 2010 Oracle and/or its affiliates.
|
|
#
|
|
# OpenOffice.org - a multi-platform office productivity suite
|
|
#
|
|
# This file is part of OpenOffice.org.
|
|
#
|
|
# OpenOffice.org is free software: you can redistribute it and/or modify
|
|
# it under the terms of the GNU Lesser General Public License version 3
|
|
# only, as published by the Free Software Foundation.
|
|
#
|
|
# OpenOffice.org 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 Lesser General Public License version 3 for more details
|
|
# (a copy is included in the LICENSE file that accompanied this code).
|
|
#
|
|
# You should have received a copy of the GNU Lesser General Public License
|
|
# version 3 along with OpenOffice.org. If not, see
|
|
# <http://www.openoffice.org/license.html>
|
|
# for a copy of the LGPLv3 License.
|
|
#
|
|
# written substantially, if not entirely by non-Sun volunteers
|
|
#
|
|
#*************************************************************************
|
|
|
|
sub sniff_set($)
|
|
{
|
|
my $build_dir = shift;
|
|
my ($dirhandle, $fname);
|
|
|
|
opendir ($dirhandle, $build_dir) || die "Can't open $build_dir";
|
|
while ($fname = readdir ($dirhandle)) {
|
|
$fname =~ /[Ss]et.sh$/ && last;
|
|
}
|
|
closedir ($dirhandle);
|
|
|
|
return $fname;
|
|
}
|
|
|
|
sub sed_file($$$)
|
|
{
|
|
my ($old_fname, $function, $state) = @_;
|
|
my $tmp_fname = "$old_fname.new";
|
|
my $old_file;
|
|
my $new_file;
|
|
|
|
open ($old_file, $old_fname) || die "Can't open $old_fname: $!";
|
|
open ($new_file, ">$tmp_fname") || die "Can't open $tmp_fname: $!";
|
|
|
|
while (<$old_file>) {
|
|
my $value = &$function($state, $_);
|
|
print $new_file $value;
|
|
}
|
|
|
|
close ($new_file) || die "Failed to close $tmp_fname: $!";
|
|
close ($old_file) || die "Failed to close $old_fname: $!";
|
|
|
|
rename $tmp_fname, $old_fname || die "Failed to replace $old_fname: $!";
|
|
}
|
|
|
|
sub rewrite_value($$)
|
|
{
|
|
my ($state, $value) = @_;
|
|
|
|
$value =~ s/$state->{'old_root'}/$state->{'new_root'}/g;
|
|
$value =~ s/$state->{'win32_old_root'}/$state->{'win32_new_root'}/g;
|
|
|
|
return $value;
|
|
}
|
|
|
|
sub rewrite_set($$$)
|
|
{
|
|
my $new_root = shift;
|
|
my $old_root = shift;
|
|
my $set = shift;
|
|
my $tmp;
|
|
my %state;
|
|
|
|
print " $set\n";
|
|
|
|
# unix style
|
|
$state{'old_root'} = $old_root;
|
|
$state{'new_root'} = $new_root;
|
|
# win32 style
|
|
$tmp = $old_root;
|
|
$tmp =~ s/\//\\\\\\\\\\\\\\\\/g;
|
|
$state{'win32_old_root'} = $tmp;
|
|
$tmp = $new_root;
|
|
$tmp =~ s/\//\\\\\\\\/g;
|
|
$state{'win32_new_root'} = $tmp;
|
|
|
|
sed_file ("$new_root/$set", \&rewrite_value, \%state);
|
|
}
|
|
|
|
sub read_set($$)
|
|
{
|
|
my $new_root = shift;
|
|
my $set = shift;
|
|
my $fname = "$new_root/$set";
|
|
my $file;
|
|
my %env_keys;
|
|
|
|
open ($file, $fname) || die "Can't open $fname: $!";
|
|
|
|
while (<$file>) {
|
|
if (/\s*([^=]+)\s*=\s*\"([^\"]+)\"/) {
|
|
my ($name, $value) = ($1, $2);
|
|
|
|
$env_keys{$name} = $value;
|
|
}
|
|
}
|
|
|
|
close ($file) || die "Failed to close $fname: $!";
|
|
|
|
return \%env_keys;
|
|
}
|
|
|
|
sub sed_file_no_touch($$$)
|
|
{
|
|
my ($new_root, $old_root, $file) = @_;
|
|
my ($fin, $fout);
|
|
|
|
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
|
|
$atime,$mtime,$ctime,$blksize,$blocks) = stat ($file);
|
|
|
|
open ($fin, $file) || die "Can't open $fin: $!";
|
|
open ($fout, ">$file.sed.bak") || die "Can't open $file.sed.bak: $!";
|
|
while (<$fin>) {
|
|
s/$old_root/$new_root/g;
|
|
print $fout $_;
|
|
}
|
|
close ($fin);
|
|
close ($fout);
|
|
rename ("$file.sed.bak", $file);
|
|
# print "rename $file.sed.bak to $file\n";
|
|
|
|
utime $atime, $mtime, $file;
|
|
}
|
|
|
|
sub sed_no_touch_recursive ($$$)
|
|
{
|
|
my ($new_root, $old_root, $dir) = @_;
|
|
my $dh;
|
|
opendir ($dh, $dir) || die "Can't open dir: $dir: $!";
|
|
while (my $entry = readdir ($dh)) {
|
|
$entry =~ /^\./ && next;
|
|
my $path = "$dir/$entry";
|
|
sed_no_touch_recursive ($new_root, $old_root, $path) if (-d $path);
|
|
sed_file_no_touch ($new_root, $old_root, $path) if (-f $path);
|
|
}
|
|
closedir ($dh);
|
|
}
|
|
|
|
sub rewrite_product_deps($$$)
|
|
{
|
|
my $new_root = shift;
|
|
my $product_path = shift;
|
|
my $old_root = shift;
|
|
|
|
my $path = "$new_root/$product_path/misc";
|
|
my $misc_dir;
|
|
opendir ($misc_dir, $path) || return;
|
|
my $name;
|
|
while ($name = readdir ($misc_dir)) {
|
|
# Should try re-writing these - but perhaps this would
|
|
# screw with timestamps ?
|
|
if ($name =~ m/\.dpcc$/ || $name =~ m/\.dpslo$/ || $name =~ m/\.dpobj$/) {
|
|
sed_file_no_touch ($new_root, $old_root, "$path/$name");
|
|
}
|
|
}
|
|
closedir ($misc_dir);
|
|
}
|
|
|
|
sub rewrite_dpcc($$)
|
|
{
|
|
my $new_root = shift;
|
|
my $old_root = shift;
|
|
|
|
my $top_dir;
|
|
my $idx = 0;
|
|
opendir ($top_dir, $new_root) || die "Can't open $new_root: $!";
|
|
my $name;
|
|
while ($name = readdir ($top_dir)) {
|
|
my $sub_dir;
|
|
opendir ($sub_dir, "$new_root/$name") || next;
|
|
my $sub_name;
|
|
while ($sub_name = readdir ($sub_dir)) {
|
|
if ($sub_name =~ /\.pro$/) {
|
|
$idx || print "\n ";
|
|
if ($idx++ == 6) {
|
|
$idx = 0;
|
|
}
|
|
print "$name ";
|
|
rewrite_product_deps ($new_root, "$name/$sub_name", $old_root);
|
|
}
|
|
}
|
|
closedir ($sub_dir);
|
|
}
|
|
closedir ($top_dir);
|
|
print "\n";
|
|
}
|
|
|
|
sub rewrite_symlinks($$)
|
|
{
|
|
my $new_root = shift;
|
|
my $old_root = shift;
|
|
|
|
my $dirh;
|
|
opendir ($dirh, $new_root);
|
|
while (my $ent = readdir ($dirh)) {
|
|
$ent =~ /^\./ && next;
|
|
my $link = "$new_root/$ent";
|
|
-l $link || next;
|
|
my $target = readlink ($link);
|
|
my $newtarget = $target;
|
|
$newtarget =~ s/$old_root/$new_root/;
|
|
if ($target =~ m/$new_root/) {
|
|
print STDERR "skip correct link $target\n";
|
|
} elsif ($newtarget eq $target) {
|
|
print STDERR "unusual - possibly stale link: $target\n";
|
|
if ($target =~ m/\/clone\//) { die "failed to rename link"; }
|
|
} else {
|
|
print "Re-write link $target to $newtarget\n";
|
|
unlink ($link);
|
|
symlink ($newtarget, $link);
|
|
}
|
|
}
|
|
closedir ($dirh);
|
|
}
|
|
|
|
sub rewrite_bootstrap($$)
|
|
{
|
|
my $new_root = shift;
|
|
my $old_root = shift;
|
|
|
|
print " bootstrap\n";
|
|
|
|
my %state;
|
|
$state{'old_root'} = $old_root;
|
|
$state{'new_root'} = $new_root;
|
|
|
|
my $rewrite = sub { my $state = shift; my $value = shift;
|
|
$value =~ s/$state->{'old_root'}/$state->{'new_root'}/g;
|
|
return $value; };
|
|
sed_file ("$new_root/bootstrap", $rewrite, \%state);
|
|
`chmod +x $new_root/bootstrap`;
|
|
}
|
|
|
|
for $a (@ARGV) {
|
|
if ($a eq '--help' || $a eq '-h') {
|
|
print "relocate: syntax\n";
|
|
print " relocate /path/to/new/ooo/source_root\n";
|
|
}
|
|
}
|
|
|
|
$OOO_BUILD = shift (@ARGV) || die "Pass path to relocated source tree";
|
|
substr ($OOO_BUILD, 0, 1) eq '/' || die "relocate requires absolute paths";
|
|
|
|
my $set;
|
|
|
|
$set = sniff_set($OOO_BUILD) || die "Can't find env. set";
|
|
my $env_keys = read_set ($OOO_BUILD, $set);
|
|
$OLD_ROOT = $env_keys->{'SRC_ROOT'};
|
|
my $solver = $env_keys->{SOLARVER} . "/" . $env_keys->{INPATH};
|
|
|
|
print "Relocate: $OLD_ROOT -> $OOO_BUILD\n";
|
|
if ($OLD_ROOT eq $OOO_BUILD) {
|
|
print "nothing to do\n";
|
|
exit 0;
|
|
}
|
|
|
|
print "re-writing symlinks\n";
|
|
rewrite_symlinks($OOO_BUILD, $OLD_ROOT);
|
|
|
|
print "re-writing dependencies:\n";
|
|
rewrite_dpcc($OOO_BUILD, $OLD_ROOT);
|
|
|
|
if (-d "$solver/workdir/Dep") {
|
|
print "re-writing new dependencies:\n";
|
|
sed_no_touch_recursive ($OOO_BUILD, $OLD_ROOT, "$solver/workdir/Dep");
|
|
}
|
|
|
|
print "re-writing environment:\n";
|
|
rewrite_set($OOO_BUILD, $OLD_ROOT, $set);
|
|
rewrite_bootstrap($OOO_BUILD, $OLD_ROOT);
|
|
|
|
print "done.\n";
|