| : |
| eval 'exec perl -S $0 ${1+"$@"}' |
| if 0; |
| |
| #************************************************************** |
| # |
| # Licensed to the Apache Software Foundation (ASF) under one |
| # or more contributor license agreements. See the NOTICE file |
| # distributed with this work for additional information |
| # regarding copyright ownership. The ASF licenses this file |
| # to you under the Apache License, Version 2.0 (the |
| # "License"); you may not use this file except in compliance |
| # with the License. You may obtain a copy of the License at |
| # |
| # http://www.apache.org/licenses/LICENSE-2.0 |
| # |
| # Unless required by applicable law or agreed to in writing, |
| # software distributed under the License is distributed on an |
| # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY |
| # KIND, either express or implied. See the License for the |
| # specific language governing permissions and limitations |
| # under the License. |
| # |
| #************************************************************** |
| # |
| # 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. |
| # |
| #************************************************************************* |
| |
| 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); |
| |
| my $tcsh_set = $set; |
| $tcsh_set =~ s/\.sh$//; |
| |
| print " $tcsh_set\n"; |
| |
| sed_file ("$new_root/$tcsh_set", \&rewrite_value, \%state); |
| } |
| |
| sub find_old_root($$) |
| { |
| my $new_root = shift; |
| my $set = shift; |
| my $fname = "$new_root/$set"; |
| my $old_root; |
| my $file; |
| |
| open ($file, $fname) || die "Can't open $fname: $!"; |
| |
| while (<$file>) { |
| if (/\s*([^=]+)\s*=\s*\"([^\"]+)\"/) { |
| my ($name, $value) = ($1, $2); |
| |
| if ($name eq 'SRC_ROOT') { |
| $old_root = $value; |
| last; |
| } |
| } |
| } |
| |
| close ($file) || die "Failed to close $fname: $!"; |
| |
| return $old_root; |
| } |
| |
| 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$/) { |
| unlink ("$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); |
| } |
| |
| 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"; |
| $OLD_ROOT = find_old_root($OOO_BUILD, $set); |
| |
| print "Relocate: $OLD_ROOT -> $OOO_BUILD\n"; |
| |
| print "re-writing environment:\n"; |
| |
| rewrite_set($OOO_BUILD, $OLD_ROOT, $set); |
| rewrite_bootstrap($OOO_BUILD, $OLD_ROOT); |
| |
| print "re-writing dependencies:\n"; |
| |
| rewrite_dpcc($OOO_BUILD, $OLD_ROOT); |
| |
| print "done.\n"; |