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