1*b1cdbd2cSJim Jagielski: 2*b1cdbd2cSJim Jagielski eval 'exec perl -S $0 ${1+"$@"}' 3*b1cdbd2cSJim Jagielski if 0; 4*b1cdbd2cSJim Jagielski 5*b1cdbd2cSJim Jagielski#************************************************************** 6*b1cdbd2cSJim Jagielski# 7*b1cdbd2cSJim Jagielski# Licensed to the Apache Software Foundation (ASF) under one 8*b1cdbd2cSJim Jagielski# or more contributor license agreements. See the NOTICE file 9*b1cdbd2cSJim Jagielski# distributed with this work for additional information 10*b1cdbd2cSJim Jagielski# regarding copyright ownership. The ASF licenses this file 11*b1cdbd2cSJim Jagielski# to you under the Apache License, Version 2.0 (the 12*b1cdbd2cSJim Jagielski# "License"); you may not use this file except in compliance 13*b1cdbd2cSJim Jagielski# with the License. You may obtain a copy of the License at 14*b1cdbd2cSJim Jagielski# 15*b1cdbd2cSJim Jagielski# http://www.apache.org/licenses/LICENSE-2.0 16*b1cdbd2cSJim Jagielski# 17*b1cdbd2cSJim Jagielski# Unless required by applicable law or agreed to in writing, 18*b1cdbd2cSJim Jagielski# software distributed under the License is distributed on an 19*b1cdbd2cSJim Jagielski# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 20*b1cdbd2cSJim Jagielski# KIND, either express or implied. See the License for the 21*b1cdbd2cSJim Jagielski# specific language governing permissions and limitations 22*b1cdbd2cSJim Jagielski# under the License. 23*b1cdbd2cSJim Jagielski# 24*b1cdbd2cSJim Jagielski#************************************************************** 25*b1cdbd2cSJim Jagielski# 26*b1cdbd2cSJim Jagielski# This tool makes it easy to cleanly re-locate a 27*b1cdbd2cSJim Jagielski# build, eg. after you have copied or moved it to a new 28*b1cdbd2cSJim Jagielski# path. It tries to re-write all the hard-coded path logic 29*b1cdbd2cSJim Jagielski# internally. 30*b1cdbd2cSJim Jagielski# 31*b1cdbd2cSJim Jagielski#************************************************************************* 32*b1cdbd2cSJim Jagielski 33*b1cdbd2cSJim Jagielskisub sniff_set($) 34*b1cdbd2cSJim Jagielski{ 35*b1cdbd2cSJim Jagielski my $build_dir = shift; 36*b1cdbd2cSJim Jagielski my ($dirhandle, $fname); 37*b1cdbd2cSJim Jagielski 38*b1cdbd2cSJim Jagielski opendir ($dirhandle, $build_dir) || die "Can't open $build_dir"; 39*b1cdbd2cSJim Jagielski while ($fname = readdir ($dirhandle)) { 40*b1cdbd2cSJim Jagielski $fname =~ /[Ss]et.sh$/ && last; 41*b1cdbd2cSJim Jagielski } 42*b1cdbd2cSJim Jagielski closedir ($dirhandle); 43*b1cdbd2cSJim Jagielski 44*b1cdbd2cSJim Jagielski return $fname; 45*b1cdbd2cSJim Jagielski} 46*b1cdbd2cSJim Jagielski 47*b1cdbd2cSJim Jagielskisub sed_file($$$) 48*b1cdbd2cSJim Jagielski{ 49*b1cdbd2cSJim Jagielski my ($old_fname, $function, $state) = @_; 50*b1cdbd2cSJim Jagielski my $tmp_fname = "$old_fname.new"; 51*b1cdbd2cSJim Jagielski my $old_file; 52*b1cdbd2cSJim Jagielski my $new_file; 53*b1cdbd2cSJim Jagielski 54*b1cdbd2cSJim Jagielski open ($old_file, $old_fname) || die "Can't open $old_fname: $!"; 55*b1cdbd2cSJim Jagielski open ($new_file, ">$tmp_fname") || die "Can't open $tmp_fname: $!"; 56*b1cdbd2cSJim Jagielski 57*b1cdbd2cSJim Jagielski while (<$old_file>) { 58*b1cdbd2cSJim Jagielski my $value = &$function($state, $_); 59*b1cdbd2cSJim Jagielski print $new_file $value; 60*b1cdbd2cSJim Jagielski } 61*b1cdbd2cSJim Jagielski 62*b1cdbd2cSJim Jagielski close ($new_file) || die "Failed to close $tmp_fname: $!"; 63*b1cdbd2cSJim Jagielski close ($old_file) || die "Failed to close $old_fname: $!"; 64*b1cdbd2cSJim Jagielski 65*b1cdbd2cSJim Jagielski rename $tmp_fname, $old_fname || die "Failed to replace $old_fname: $!"; 66*b1cdbd2cSJim Jagielski} 67*b1cdbd2cSJim Jagielski 68*b1cdbd2cSJim Jagielskisub rewrite_value($$) 69*b1cdbd2cSJim Jagielski{ 70*b1cdbd2cSJim Jagielski my ($state, $value) = @_; 71*b1cdbd2cSJim Jagielski 72*b1cdbd2cSJim Jagielski $value =~ s/$state->{'old_root'}/$state->{'new_root'}/g; 73*b1cdbd2cSJim Jagielski $value =~ s/$state->{'win32_old_root'}/$state->{'win32_new_root'}/g; 74*b1cdbd2cSJim Jagielski 75*b1cdbd2cSJim Jagielski return $value; 76*b1cdbd2cSJim Jagielski} 77*b1cdbd2cSJim Jagielski 78*b1cdbd2cSJim Jagielskisub rewrite_set($$$) 79*b1cdbd2cSJim Jagielski{ 80*b1cdbd2cSJim Jagielski my $new_root = shift; 81*b1cdbd2cSJim Jagielski my $old_root = shift; 82*b1cdbd2cSJim Jagielski my $set = shift; 83*b1cdbd2cSJim Jagielski my $tmp; 84*b1cdbd2cSJim Jagielski my %state; 85*b1cdbd2cSJim Jagielski 86*b1cdbd2cSJim Jagielski print " $set\n"; 87*b1cdbd2cSJim Jagielski 88*b1cdbd2cSJim Jagielski# unix style 89*b1cdbd2cSJim Jagielski $state{'old_root'} = $old_root; 90*b1cdbd2cSJim Jagielski $state{'new_root'} = $new_root; 91*b1cdbd2cSJim Jagielski# win32 style 92*b1cdbd2cSJim Jagielski $tmp = $old_root; 93*b1cdbd2cSJim Jagielski $tmp =~ s/\//\\\\\\\\\\\\\\\\/g; 94*b1cdbd2cSJim Jagielski $state{'win32_old_root'} = $tmp; 95*b1cdbd2cSJim Jagielski $tmp = $new_root; 96*b1cdbd2cSJim Jagielski $tmp =~ s/\//\\\\\\\\/g; 97*b1cdbd2cSJim Jagielski $state{'win32_new_root'} = $tmp; 98*b1cdbd2cSJim Jagielski 99*b1cdbd2cSJim Jagielski sed_file ("$new_root/$set", \&rewrite_value, \%state); 100*b1cdbd2cSJim Jagielski 101*b1cdbd2cSJim Jagielski my $tcsh_set = $set; 102*b1cdbd2cSJim Jagielski $tcsh_set =~ s/\.sh$//; 103*b1cdbd2cSJim Jagielski 104*b1cdbd2cSJim Jagielski print " $tcsh_set\n"; 105*b1cdbd2cSJim Jagielski 106*b1cdbd2cSJim Jagielski sed_file ("$new_root/$tcsh_set", \&rewrite_value, \%state); 107*b1cdbd2cSJim Jagielski} 108*b1cdbd2cSJim Jagielski 109*b1cdbd2cSJim Jagielskisub find_old_root($$) 110*b1cdbd2cSJim Jagielski{ 111*b1cdbd2cSJim Jagielski my $new_root = shift; 112*b1cdbd2cSJim Jagielski my $set = shift; 113*b1cdbd2cSJim Jagielski my $fname = "$new_root/$set"; 114*b1cdbd2cSJim Jagielski my $old_root; 115*b1cdbd2cSJim Jagielski my $file; 116*b1cdbd2cSJim Jagielski 117*b1cdbd2cSJim Jagielski open ($file, $fname) || die "Can't open $fname: $!"; 118*b1cdbd2cSJim Jagielski 119*b1cdbd2cSJim Jagielski while (<$file>) { 120*b1cdbd2cSJim Jagielski if (/\s*([^=]+)\s*=\s*\"([^\"]+)\"/) { 121*b1cdbd2cSJim Jagielski my ($name, $value) = ($1, $2); 122*b1cdbd2cSJim Jagielski 123*b1cdbd2cSJim Jagielski if ($name eq 'SRC_ROOT') { 124*b1cdbd2cSJim Jagielski $old_root = $value; 125*b1cdbd2cSJim Jagielski last; 126*b1cdbd2cSJim Jagielski } 127*b1cdbd2cSJim Jagielski } 128*b1cdbd2cSJim Jagielski } 129*b1cdbd2cSJim Jagielski 130*b1cdbd2cSJim Jagielski close ($file) || die "Failed to close $fname: $!"; 131*b1cdbd2cSJim Jagielski 132*b1cdbd2cSJim Jagielski return $old_root; 133*b1cdbd2cSJim Jagielski} 134*b1cdbd2cSJim Jagielski 135*b1cdbd2cSJim Jagielskisub rewrite_product_deps($$$) 136*b1cdbd2cSJim Jagielski{ 137*b1cdbd2cSJim Jagielski my $new_root = shift; 138*b1cdbd2cSJim Jagielski my $product_path = shift; 139*b1cdbd2cSJim Jagielski my $old_root = shift; 140*b1cdbd2cSJim Jagielski 141*b1cdbd2cSJim Jagielski my $path = "$new_root/$product_path/misc"; 142*b1cdbd2cSJim Jagielski my $misc_dir; 143*b1cdbd2cSJim Jagielski opendir ($misc_dir, $path) || return; 144*b1cdbd2cSJim Jagielski my $name; 145*b1cdbd2cSJim Jagielski while ($name = readdir ($misc_dir)) { 146*b1cdbd2cSJim Jagielski# Should try re-writing these - but perhaps this would 147*b1cdbd2cSJim Jagielski# screw with timestamps ? 148*b1cdbd2cSJim Jagielski if ($name =~ m/\.dpcc$/ || $name =~ m/\.dpslo$/ || $name =~ m/\.dpobj$/) { 149*b1cdbd2cSJim Jagielski unlink ("$path/$name"); 150*b1cdbd2cSJim Jagielski } 151*b1cdbd2cSJim Jagielski } 152*b1cdbd2cSJim Jagielski closedir ($misc_dir); 153*b1cdbd2cSJim Jagielski} 154*b1cdbd2cSJim Jagielski 155*b1cdbd2cSJim Jagielskisub rewrite_dpcc($$) 156*b1cdbd2cSJim Jagielski{ 157*b1cdbd2cSJim Jagielski my $new_root = shift; 158*b1cdbd2cSJim Jagielski my $old_root = shift; 159*b1cdbd2cSJim Jagielski 160*b1cdbd2cSJim Jagielski my $top_dir; 161*b1cdbd2cSJim Jagielski my $idx = 0; 162*b1cdbd2cSJim Jagielski opendir ($top_dir, $new_root) || die "Can't open $new_root: $!"; 163*b1cdbd2cSJim Jagielski my $name; 164*b1cdbd2cSJim Jagielski while ($name = readdir ($top_dir)) { 165*b1cdbd2cSJim Jagielski my $sub_dir; 166*b1cdbd2cSJim Jagielski opendir ($sub_dir, "$new_root/$name") || next; 167*b1cdbd2cSJim Jagielski my $sub_name; 168*b1cdbd2cSJim Jagielski while ($sub_name = readdir ($sub_dir)) { 169*b1cdbd2cSJim Jagielski if ($sub_name =~ /\.pro$/) { 170*b1cdbd2cSJim Jagielski $idx || print "\n "; 171*b1cdbd2cSJim Jagielski if ($idx++ == 6) { 172*b1cdbd2cSJim Jagielski $idx = 0; 173*b1cdbd2cSJim Jagielski } 174*b1cdbd2cSJim Jagielski print "$name "; 175*b1cdbd2cSJim Jagielski rewrite_product_deps ($new_root, "$name/$sub_name", $old_root); 176*b1cdbd2cSJim Jagielski } 177*b1cdbd2cSJim Jagielski } 178*b1cdbd2cSJim Jagielski closedir ($sub_dir); 179*b1cdbd2cSJim Jagielski } 180*b1cdbd2cSJim Jagielski closedir ($top_dir); 181*b1cdbd2cSJim Jagielski} 182*b1cdbd2cSJim Jagielski 183*b1cdbd2cSJim Jagielskisub rewrite_bootstrap($$) 184*b1cdbd2cSJim Jagielski{ 185*b1cdbd2cSJim Jagielski my $new_root = shift; 186*b1cdbd2cSJim Jagielski my $old_root = shift; 187*b1cdbd2cSJim Jagielski 188*b1cdbd2cSJim Jagielski print " bootstrap\n"; 189*b1cdbd2cSJim Jagielski 190*b1cdbd2cSJim Jagielski my %state; 191*b1cdbd2cSJim Jagielski $state{'old_root'} = $old_root; 192*b1cdbd2cSJim Jagielski $state{'new_root'} = $new_root; 193*b1cdbd2cSJim Jagielski 194*b1cdbd2cSJim Jagielski my $rewrite = sub { my $state = shift; my $value = shift; 195*b1cdbd2cSJim Jagielski $value =~ s/$state->{'old_root'}/$state->{'new_root'}/g; 196*b1cdbd2cSJim Jagielski return $value; }; 197*b1cdbd2cSJim Jagielski sed_file ("$new_root/bootstrap", $rewrite, \%state); 198*b1cdbd2cSJim Jagielski `chmod +x $new_root/bootstrap`; 199*b1cdbd2cSJim Jagielski} 200*b1cdbd2cSJim Jagielski 201*b1cdbd2cSJim Jagielskifor $a (@ARGV) { 202*b1cdbd2cSJim Jagielski if ($a eq '--help' || $a eq '-h') { 203*b1cdbd2cSJim Jagielski print "relocate: syntax\n"; 204*b1cdbd2cSJim Jagielski print " relocate /path/to/new/ooo/source_root\n"; 205*b1cdbd2cSJim Jagielski } 206*b1cdbd2cSJim Jagielski} 207*b1cdbd2cSJim Jagielski 208*b1cdbd2cSJim Jagielski$OOO_BUILD = shift (@ARGV) || die "Pass path to relocated source tree"; 209*b1cdbd2cSJim Jagielskisubstr ($OOO_BUILD, 0, 1) eq '/' || die "relocate requires absolute paths"; 210*b1cdbd2cSJim Jagielski 211*b1cdbd2cSJim Jagielskimy $set; 212*b1cdbd2cSJim Jagielski 213*b1cdbd2cSJim Jagielski$set = sniff_set($OOO_BUILD) || die "Can't find env. set"; 214*b1cdbd2cSJim Jagielski$OLD_ROOT = find_old_root($OOO_BUILD, $set); 215*b1cdbd2cSJim Jagielski 216*b1cdbd2cSJim Jagielskiprint "Relocate: $OLD_ROOT -> $OOO_BUILD\n"; 217*b1cdbd2cSJim Jagielski 218*b1cdbd2cSJim Jagielskiprint "re-writing environment:\n"; 219*b1cdbd2cSJim Jagielski 220*b1cdbd2cSJim Jagielskirewrite_set($OOO_BUILD, $OLD_ROOT, $set); 221*b1cdbd2cSJim Jagielskirewrite_bootstrap($OOO_BUILD, $OLD_ROOT); 222*b1cdbd2cSJim Jagielski 223*b1cdbd2cSJim Jagielskiprint "re-writing dependencies:\n"; 224*b1cdbd2cSJim Jagielski 225*b1cdbd2cSJim Jagielskirewrite_dpcc($OOO_BUILD, $OLD_ROOT); 226*b1cdbd2cSJim Jagielski 227*b1cdbd2cSJim Jagielskiprint "done.\n"; 228