solenv/bin/relocate

   1 :
   2     eval 'exec perl -S $0 ${1+"$@"}'
   3         if 0;
   4
   5 #*************************************************************************
   6 #
   7 #    This tool makes it easy to cleanly re-locate a
   8 # build, eg. after you have copied or moved it to a new
   9 # path. It tries to re-write all the hard-coded path logic
  10 # internally.
  11 #
  12 #*************************************************************************
  13 #
  14 # DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
  15 #
  16 # Copyright 2008 by Sun Microsystems, Inc.
  17 #
  18 # OpenOffice.org - a multi-platform office productivity suite
  19 #
  20 # $RCSfile: relocate,v $
  21 #
  22 # $Revision: 1.6 $
  23 #
  24 # This file is part of OpenOffice.org.
  25 #
  26 # OpenOffice.org is free software: you can redistribute it and/or modify
  27 # it under the terms of the GNU Lesser General Public License version 3
  28 # only, as published by the Free Software Foundation.
  29 #
  30 # OpenOffice.org is distributed in the hope that it will be useful,
  31 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  32 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  33 # GNU Lesser General Public License version 3 for more details
  34 # (a copy is included in the LICENSE file that accompanied this code).
  35 #
  36 # You should have received a copy of the GNU Lesser General Public License
  37 # version 3 along with OpenOffice.org.  If not, see
  38 # <http://www.openoffice.org/license.html>
  39 # for a copy of the LGPLv3 License.
  40 #
  41 #*************************************************************************
  42
  43 sub sniff_set($)
  44 {
  45     my $build_dir = shift;
  46     my ($dirhandle, $fname);
  47
  48     opendir ($dirhandle, $build_dir) || die "Can't open $build_dir";
  49     while ($fname = readdir ($dirhandle)) {
  50         $fname =~ /[Ss]et.sh$/ && last;
  51     }
  52     closedir ($dirhandle);
  53
  54     return $fname;
  55 }
  56
  57 sub sed_file($$$)
  58 {
  59     my ($old_fname, $function, $state) = @_;
  60     my $tmp_fname = "$old_fname.new";
  61     my $old_file;
  62     my $new_file;
  63
  64     open ($old_file, $old_fname) || die "Can't open $old_fname: $!";
  65     open ($new_file, ">$tmp_fname") || die "Can't open $tmp_fname: $!";
  66
  67     while (<$old_file>) {
  68         my $value = &$function($state, $_);
  69         print $new_file $value;
  70     }
  71
  72     close ($new_file) || die "Failed to close $tmp_fname: $!";
  73     close ($old_file) || die "Failed to close $old_fname: $!";
  74
  75     rename $tmp_fname, $old_fname || die "Failed to replace $old_fname: $!";
  76 }
  77
  78 sub rewrite_value($$)
  79 {
  80     my ($state, $value) = @_;
  81
  82     $value =~ s/$state->{'old_root'}/$state->{'new_root'}/g;
  83     $value =~ s/$state->{'win32_old_root'}/$state->{'win32_new_root'}/g;
  84
  85     return $value;
  86 }
  87
  88 sub rewrite_set($$$)
  89 {
  90     my $new_root = shift;
  91     my $old_root = shift;
  92     my $set = shift;
  93     my $tmp;
  94     my %state;
  95
  96     print "   $set\n";
  97
  98 # unix style
  99     $state{'old_root'} = $old_root;
 100     $state{'new_root'} = $new_root;
 101 # win32 style
 102     $tmp = $old_root;
 103     $tmp =~ s/\//\\\\\\\\\\\\\\\\/g;
 104     $state{'win32_old_root'} = $tmp;
 105     $tmp = $new_root;
 106     $tmp =~ s/\//\\\\\\\\/g;
 107     $state{'win32_new_root'} = $tmp;
 108
 109     sed_file ("$new_root/$set", \&rewrite_value, \%state);
 110
 111     my $tcsh_set = $set;
 112     $tcsh_set =~ s/\.sh$//;
 113
 114     print "   $tcsh_set\n";
 115
 116     sed_file ("$new_root/$tcsh_set", \&rewrite_value, \%state);
 117 }
 118
 119 sub find_old_root($$)
 120 {
 121     my $new_root = shift;
 122     my $set = shift;
 123     my $fname = "$new_root/$set";
 124     my $old_root;
 125     my $file;
 126
 127     open ($file, $fname) || die "Can't open $fname: $!";
 128
 129     while (<$file>) {
 130         if (/\s*([^=]+)\s*=\s*\"([^\"]+)\"/) {
 131             my ($name, $value) = ($1, $2);
 132
 133             if ($name eq 'SRC_ROOT') {
 134                 $old_root = $value;
 135                 last;
 136             }
 137         }
 138     }
 139
 140     close ($file) || die "Failed to close $fname: $!";
 141
 142     return $old_root;
 143 }
 144
 145 sub rewrite_product_deps($$$)
 146 {
 147     my $new_root = shift;
 148     my $product_path = shift;
 149     my $old_root = shift;
 150
 151     my $path = "$new_root/$product_path/misc";
 152     my $misc_dir;
 153     opendir ($misc_dir, $path) || return;
 154     my $name;
 155     while ($name = readdir ($misc_dir)) {
 156 # Should try re-writing these - but perhaps this would
 157 # screw with timestamps ?
 158     if ($name =~ m/\.dpcc$/ || $name =~ m/\.dpslo$/ || $name =~ m/\.dpobj$/) {
 159                 unlink ("$path/$name");
 160         }
 161     }
 162     closedir ($misc_dir);
 163 }
 164
 165 sub rewrite_dpcc($$)
 166 {
 167     my $new_root = shift;
 168     my $old_root = shift;
 169
 170     my $top_dir;
 171     my $idx = 0;
 172     opendir ($top_dir, $new_root) || die "Can't open $new_root: $!";
 173     my $name;
 174     while ($name = readdir ($top_dir)) {
 175         my $sub_dir;
 176         opendir ($sub_dir, "$new_root/$name") || next;
 177         my $sub_name;
 178         while ($sub_name = readdir ($sub_dir)) {
 179             if ($sub_name =~ /\.pro$/) {
 180                 $idx || print "\n    ";
 181                 if ($idx++ == 6) {
 182                     $idx = 0;
 183                 }
 184                 print "$name ";
 185                 rewrite_product_deps ($new_root, "$name/$sub_name", $old_root);
 186             }
 187         }
 188         closedir ($sub_dir);
 189     }
 190     closedir ($top_dir);
 191 }
 192
 193 sub rewrite_bootstrap($$)
 194 {
 195     my $new_root = shift;
 196     my $old_root = shift;
 197
 198     print "   bootstrap\n";
 199
 200     my %state;
 201     $state{'old_root'} = $old_root;
 202     $state{'new_root'} = $new_root;
 203
 204     my $rewrite = sub { my $state = shift; my $value = shift;
 205                         $value =~ s/$state->{'old_root'}/$state->{'new_root'}/g;
 206                         return $value; };
 207     sed_file ("$new_root/bootstrap", $rewrite, \%state);
 208     `chmod +x $new_root/bootstrap`;
 209 }
 210
 211 for $a (@ARGV) {
 212     if ($a eq '--help' || $a eq '-h') {
 213         print "relocate: syntax\n";
 214         print "  relocate /path/to/new/ooo/source_root\n";
 215     }
 216 }
 217
 218 $OOO_BUILD = shift (@ARGV) || die "Pass path to relocated source tree";
 219 substr ($OOO_BUILD, 0, 1) eq '/' || die "relocate requires absolute paths";
 220
 221 my $set;
 222
 223 $set = sniff_set($OOO_BUILD) || die "Can't find env. set";
 224 $OLD_ROOT = find_old_root($OOO_BUILD, $set);
 225
 226 print "Relocate: $OLD_ROOT -> $OOO_BUILD\n";
 227
 228 print "re-writing environment:\n";
 229
 230 rewrite_set($OOO_BUILD, $OLD_ROOT, $set);
 231 rewrite_bootstrap($OOO_BUILD, $OLD_ROOT);
 232
 233 print "re-writing dependencies:\n";
 234
 235 rewrite_dpcc($OOO_BUILD, $OLD_ROOT);
 236
 237 print "done.\n";