solenv/bin/relocate

   1 :
   2     eval 'exec perl -S $0 ${1+"$@"}'
   3         if 0;
   4 #
   5 # This file is part of the LibreOffice project.
   6 #
   7 # This Source Code Form is subject to the terms of the Mozilla Public
   8 # License, v. 2.0. If a copy of the MPL was not distributed with this
   9 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
  10 #
  11 # This file incorporates work covered by the following license notice:
  12 #
  13 #   Licensed to the Apache Software Foundation (ASF) under one or more
  14 #   contributor license agreements. See the NOTICE file distributed
  15 #   with this work for additional information regarding copyright
  16 #   ownership. The ASF licenses this file to you under the Apache
  17 #   License, Version 2.0 (the "License"); you may not use this file
  18 #   except in compliance with the License. You may obtain a copy of
  19 #   the License at http://www.apache.org/licenses/LICENSE-2.0 .
  20 #
  21 #*************************************************************************
  22 #
  23 #    This tool makes it easy to cleanly re-locate a
  24 # build, eg. after you have copied or moved it to a new
  25 # path. It tries to re-write all the hard-coded path logic
  26 # internally.
  27 #
  28
  29 sub sniff_set($)
  30 {
  31     my $build_dir = shift;
  32     my ($dirhandle, $fname);
  33
  34     opendir ($dirhandle, $build_dir) || die "Can't open $build_dir";
  35     while ($fname = readdir ($dirhandle)) {
  36         $fname =~ /Set.sh$/ && last;
  37     }
  38     closedir ($dirhandle);
  39
  40     return $fname;
  41 }
  42
  43 sub sed_file($$$)
  44 {
  45     my ($old_fname, $function, $state) = @_;
  46     my $tmp_fname = "$old_fname.new";
  47     my $old_file;
  48     my $new_file;
  49
  50     open ($old_file, $old_fname) || die "Can't open $old_fname: $!";
  51     open ($new_file, ">$tmp_fname") || die "Can't open $tmp_fname: $!";
  52
  53     while (<$old_file>) {
  54         my $value = &$function($state, $_);
  55         print $new_file $value;
  56     }
  57
  58     close ($new_file) || die "Failed to close $tmp_fname: $!";
  59     close ($old_file) || die "Failed to close $old_fname: $!";
  60
  61     rename $tmp_fname, $old_fname || die "Failed to replace $old_fname: $!";
  62 }
  63
  64 sub rewrite_value($$)
  65 {
  66     my ($state, $value) = @_;
  67
  68     $value =~ s/$state->{'old_root'}/$state->{'new_root'}/g;
  69     $value =~ s/$state->{'win32_old_root'}/$state->{'win32_new_root'}/g;
  70
  71     return $value;
  72 }
  73
  74 sub rewrite_set($$$)
  75 {
  76     my $new_root = shift;
  77     my $old_root = shift;
  78     my $set = shift;
  79     my $tmp;
  80     my %state;
  81
  82     print "   $set\n";
  83
  84 # unix style
  85     $state{'old_root'} = $old_root;
  86     $state{'new_root'} = $new_root;
  87 # win32 style
  88     $tmp = $old_root;
  89     $tmp =~ s/\//\\\\\\\\\\\\\\\\/g;
  90     $state{'win32_old_root'} = $tmp;
  91     $tmp = $new_root;
  92     $tmp =~ s/\//\\\\\\\\/g;
  93     $state{'win32_new_root'} = $tmp;
  94
  95     sed_file ("$new_root/$set", \&rewrite_value, \%state);
  96 }
  97
  98 sub read_set($$)
  99 {
 100     my $new_root = shift;
 101     my $set = shift;
 102     my $fname = "$new_root/$set";
 103     my $file;
 104     my %env_keys;
 105
 106     open ($file, $fname) || die "Can't open $fname: $!";
 107
 108     while (<$file>) {
 109         if (/\s*([^=]+)\s*=\s*\"([^\"]+)\"/) {
 110             my ($name, $value) = ($1, $2);
 111
 112             $env_keys{$name} = $value;
 113         }
 114     }
 115
 116     close ($file) || die "Failed to close $fname: $!";
 117
 118     return \%env_keys;
 119 }
 120
 121 sub sed_file_no_touch($$$)
 122 {
 123     my ($new_root, $old_root, $file) = @_;
 124     my ($fin, $fout);
 125
 126     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
 127      $atime,$mtime,$ctime,$blksize,$blocks) = stat ($file);
 128
 129     open ($fin, $file) || die "Can't open $fin: $!";
 130     open ($fout, ">$file.sed.bak") || die "Can't open $file.sed.bak: $!";
 131     while (<$fin>) {
 132         s/$old_root/$new_root/g;
 133         print $fout $_;
 134     }
 135     close ($fin);
 136     close ($fout);
 137     rename ("$file.sed.bak", $file);
 138 #    print "rename $file.sed.bak to $file\n";
 139
 140     utime $atime, $mtime, $file;
 141 }
 142
 143 sub sed_no_touch_recursive ($$$)
 144 {
 145     my ($new_root, $old_root, $dir) = @_;
 146     my $dh;
 147     opendir ($dh, $dir) || die "Can't open dir: $dir: $!";
 148     while (my $entry = readdir ($dh)) {
 149         $entry =~ /^\./ && next;
 150         my $path = "$dir/$entry";
 151         sed_no_touch_recursive ($new_root, $old_root, $path) if (-d $path);
 152         sed_file_no_touch ($new_root, $old_root, $path) if (-f $path);
 153     }
 154     closedir ($dh);
 155 }
 156
 157 sub rewrite_product_deps($$$)
 158 {
 159     my $new_root = shift;
 160     my $product_path = shift;
 161     my $old_root = shift;
 162
 163     my $path = "$new_root/$product_path/misc";
 164     my $misc_dir;
 165     opendir ($misc_dir, $path) || return;
 166     my $name;
 167     while ($name = readdir ($misc_dir)) {
 168 # Should try re-writing these - but perhaps this would
 169 # screw with timestamps ?
 170         if ($name =~ m/\.dpcc$/ || $name =~ m/\.dpslo$/ || $name =~ m/\.dpobj$/) {
 171             sed_file_no_touch ($new_root, $old_root, "$path/$name");
 172         }
 173     }
 174     closedir ($misc_dir);
 175 }
 176
 177 sub rewrite_dpcc($$)
 178 {
 179     my $new_root = shift;
 180     my $old_root = shift;
 181
 182     my $top_dir;
 183     my $idx = 0;
 184     opendir ($top_dir, $new_root) || die "Can't open $new_root: $!";
 185     my $name;
 186     while ($name = readdir ($top_dir)) {
 187         my $sub_dir;
 188         opendir ($sub_dir, "$new_root/$name") || next;
 189         my $sub_name;
 190         while ($sub_name = readdir ($sub_dir)) {
 191             if ($sub_name =~ /\.pro$/) {
 192                 $idx || print "\n    ";
 193                 if ($idx++ == 6) {
 194                     $idx = 0;
 195                 }
 196                 print "$name ";
 197                 rewrite_product_deps ($new_root, "$name/$sub_name", $old_root);
 198             }
 199         }
 200         closedir ($sub_dir);
 201     }
 202     closedir ($top_dir);
 203     print "\n";
 204 }
 205
 206 sub rewrite_symlinks($$)
 207 {
 208     my $new_root = shift;
 209     my $old_root = shift;
 210
 211     my $dirh;
 212     opendir ($dirh, $new_root);
 213     while (my $ent = readdir ($dirh)) {
 214         $ent =~ /^\./ && next;
 215         my $link = "$new_root/$ent";
 216         -l $link || next;
 217         my $target = readlink ($link);
 218         my $newtarget = $target;
 219         $newtarget =~ s/$old_root/$new_root/;
 220         if ($target =~ m/$new_root/) {
 221             print STDERR "skip correct link $target\n";
 222         } elsif ($newtarget eq $target) {
 223             print STDERR "unusual - possibly stale link: $target\n";
 224             if ($target =~ m/\/clone\//) { die "failed to rename link"; }
 225         } else {
 226             print "Re-write link $target to $newtarget\n";
 227             unlink ($link);
 228             symlink ($newtarget, $link);
 229         }
 230     }
 231     closedir ($dirh);
 232 }
 233
 234 sub rewrite_bootstrap($$)
 235 {
 236     my $new_root = shift;
 237     my $old_root = shift;
 238
 239     print "   bootstrap\n";
 240
 241     my %state;
 242     $state{'old_root'} = $old_root;
 243     $state{'new_root'} = $new_root;
 244
 245     my $rewrite = sub { my $state = shift; my $value = shift;
 246                         $value =~ s/$state->{'old_root'}/$state->{'new_root'}/g;
 247                         return $value; };
 248     sed_file ("$new_root/bootstrap", $rewrite, \%state);
 249     `chmod +x $new_root/bootstrap`;
 250 }
 251
 252 for $a (@ARGV) {
 253     if ($a eq '--help' || $a eq '-h') {
 254         print "relocate: syntax\n";
 255         print "  relocate /path/to/new/ooo/source_root\n";
 256     }
 257 }
 258
 259 $OOO_BUILD = shift (@ARGV) || die "Pass path to relocated source tree";
 260 substr ($OOO_BUILD, 0, 1) eq '/' || die "relocate requires absolute paths";
 261
 262 my $set;
 263
 264 $set = sniff_set($OOO_BUILD) || die "Can't find env. set";
 265 my $env_keys = read_set ($OOO_BUILD, $set);
 266 $OLD_ROOT = $env_keys->{'SRC_ROOT'};
 267 my $solver = $env_keys->{SOLARVER} . "/" . $env_keys->{INPATH};
 268
 269 print "Relocate: $OLD_ROOT -> $OOO_BUILD\n";
 270 if ($OLD_ROOT eq $OOO_BUILD) {
 271     print "nothing to do\n";
 272     exit 0;
 273 }
 274
 275 print "re-writing symlinks\n";
 276 rewrite_symlinks($OOO_BUILD, $OLD_ROOT);
 277
 278 print "re-writing dependencies:\n";
 279 rewrite_dpcc($OOO_BUILD, $OLD_ROOT);
 280
 281 if (-d "$solver/workdir/Dep") {
 282     print "re-writing new dependencies:\n";
 283     sed_no_touch_recursive ($OOO_BUILD, $OLD_ROOT, "$solver/workdir/Dep");
 284 }
 285
 286 print "re-writing environment:\n";
 287 rewrite_set($OOO_BUILD, $OLD_ROOT, $set);
 288 rewrite_bootstrap($OOO_BUILD, $OLD_ROOT);
 289
 290 print "done.\n";