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