solenv/bin/linkoo

   1 :
   2     eval 'exec perl -S $0 ${1+"$@"}'
   3         if 0;
   4
   5 #
   6 # This file is part of the LibreOffice project.
   7 #
   8 # This Source Code Form is subject to the terms of the Mozilla Public
   9 # License, v. 2.0. If a copy of the MPL was not distributed with this
  10 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
  11 #
  12 # This file incorporates work covered by the following license notice:
  13 #
  14 #   Licensed to the Apache Software Foundation (ASF) under one or more
  15 #   contributor license agreements. See the NOTICE file distributed
  16 #   with this work for additional information regarding copyright
  17 #   ownership. The ASF licenses this file to you under the Apache
  18 #   License, Version 2.0 (the "License"); you may not use this file
  19 #   except in compliance with the License. You may obtain a copy of
  20 #   the License at http://www.apache.org/licenses/LICENSE-2.0 .
  21 #
  22 #*************************************************************************
  23 #
  24 #    This app makes it easy to link a live build
  25 # set into an install set. Then your devel iteration
  26 # is: 'build', execute.
  27 #
  28 #*************************************************************************
  29
  30 use strict;
  31 use File::stat;
  32 use File::Copy;
  33 use File::Find;
  34 use File::Spec::Functions qw[splitdir catdir];
  35
  36 # ends up in program/ooenv
  37 ( my $moz_lib = `pkg-config --variable=libdir mozilla-nss` ) =~ tr/\n/:/;
  38 my $env_script = '
  39 java_path=`$thisdir/../ure-link/bin/javaldx 2>/dev/null`
  40 export LD_LIBRARY_PATH="$thisdir:$java_path:' . $moz_lib . '$LD_LIBRARY_PATH"
  41 ulimit -c unlimited
  42 export PATH="$thisdir:$thisdir/../ure-link/bin:$PATH"
  43 export GNOME_DISABLE_CRASH_DIALOG=1
  44 # debugging assistance
  45 export SAL_DISABLE_FLOATGRAB=1
  46 export G_SLICE=always-malloc
  47 export MALLOC_CHECK_=2
  48 export MALLOC_PERTURB_=153
  49 export OOO_DISABLE_RECOVERY=1
  50 export SAL_ALLOW_LINKOO_SYMLINKS=1
  51 ';
  52
  53 my $dry_run = 0;
  54 my $backup = 0;
  55 my $copy = 0;
  56 my $usage = 0;
  57 my $windows = 0;
  58 my $LANG;
  59 my $TARGET;
  60 my $LIBVER;
  61 my $OOO_BUILD;
  62 my $OOO_INSTALL;
  63 my $SOLARVER;
  64
  65 if ($ENV{'OS'} eq 'MACOSX') {
  66     print "FIXME: linkoo currently does not work on Mac OS X\n";
  67     exit(0);
  68 }
  69
  70 # process options
  71 for my $a (@ARGV) {
  72
  73     # options
  74     if ($a =~ /--dry-run/) {
  75         $dry_run = 1;
  76     } elsif (($a eq '--help') || ($a eq '-h')) {
  77         $usage = 1;
  78     } elsif ($a eq '--backup') {
  79         $backup = 1;
  80     } elsif ($a eq '--copy') {
  81         $copy = 1;
  82     # ordered arguments
  83     } elsif (!defined $OOO_INSTALL) {
  84         $OOO_INSTALL = $a;
  85     } elsif (!defined $OOO_BUILD) {
  86         $OOO_BUILD = $a;
  87     } else {
  88         print "Unknown argument '$a'\n";
  89         $usage = 1;
  90     }
  91 }
  92
  93 if (!defined $OOO_BUILD && defined $ENV{SRC_ROOT}) {
  94     $OOO_BUILD = $ENV{SRC_ROOT};
  95 }
  96
  97 if ($usage || !defined $OOO_INSTALL || !defined $OOO_BUILD) {
  98     printf "Usage: linkoo </path/to/ooo/install> [</path/to/ooo/build/tree>] [--dry-run] [--backup] [--copy]\n";
  99     exit (1);
 100 }
 101
 102 File::Spec->file_name_is_absolute($OOO_INSTALL) || die "linkoo requires absolute paths ($OOO_INSTALL does not qualify)";
 103 File::Spec->file_name_is_absolute($OOO_BUILD) || die "linkoo requires absolute paths ($OOO_BUILD does not qualify)";
 104
 105 -d $OOO_INSTALL || die "No such directory $OOO_INSTALL";
 106 -w $OOO_INSTALL || die "You need write access to $OOO_INSTALL";
 107 -d $OOO_BUILD || die "No such directory $OOO_BUILD";
 108
 109 ($TARGET, $LIBVER, $LANG) = sniff_target ($OOO_BUILD);
 110
 111 $SOLARVER = "$OOO_BUILD/solver";
 112
 113 if ($TARGET =~ /^wntgcci/ || $TARGET =~ /^wntmsci[0-9]+/) {
 114     $windows = 1;
 115 }
 116
 117 if ($TARGET =~ /^wntmsci[0-9]+/) {
 118     # wntgcci means are cross-compiling & can symlink, so copy only on real
 119     # Windows
 120     $copy = 1;
 121 }
 122
 123 # setup global variables
 124 my $brand_program_dir = 'program';
 125 my $ure_lib_dir = 'ure-link/lib';
 126 my $win_ure_lib_dir = 'URE/bin';
 127
 128 my @exceptions = ( 'libsunjavaplugin', 'libjvmfwk' );
 129 push @exceptions, 'cppuhelper' if (!$windows);
 130
 131 my $bin;
 132 $bin = "|\\.bin" if ($windows);
 133 my %replaceable = (
 134     $brand_program_dir => "(\\.so|\\.dll|\\.exe|\\.com$bin)\$",
 135     $ure_lib_dir => "(\\.so\$|\\.so\\.3\$)",
 136     $win_ure_lib_dir => "(\\.dll|\\.exe|\\.bin|\\.com)\$",
 137     $brand_program_dir . '/resource' => '\.res$',
 138     $brand_program_dir . '/classes' => '\.jar$',
 139     'ure-link/share/java' => '\.jar$',
 140     'share/extensions/nlpsolver' => '\.jar$',
 141     'share/extensions/wiki-publisher' => '\.jar$',
 142     'share/extensions/pdf-import' => "(\\.so|\\.dll|\\.exe|\\.com$bin)\$",
 143     'share/extensions/presenter-screen' => "(\\.so|\\.dll|\\.exe|\\.com$bin)\$",
 144     'share/extensions/presentation-minimizer' => "(\\.so|\\.dll|\\.exe|\\.com$bin)\$",
 145     'share/config' => '\.zip$',
 146 #    'share/uno_packages' => '\.zip$'
 147 );
 148
 149 my @instdir_replaceable = (
 150     'share',
 151     'program',
 152 #    'presets', # leave these guys alone for now
 153     'help',
 154 );
 155
 156 my @search_dirs = ( 'lib', 'bin', 'class' );
 157
 158 my @known_duplicates = ( 'db.jar', 'libi18n', 'libnssckbi', 'libnssdbm', 'libsqlite3', 'libnssutil3', 'pythonloader.uno', 'pyuno', 'libpyuno' );
 159
 160 sub sniff_target($)
 161 {
 162     my $build_dir = shift;
 163     my ($target, $libver, $lang) = ( 'unxlngi6.pro', '680', 'en-US' ); # defaults
 164
 165     chomp($target=`cat $build_dir/config_host.mk | grep INPATH= | sed -e 's/.*=//' | sed -e 's/"//g'`);
 166     chomp($libver=`cat $build_dir/config_host.mk | grep UPD= | sed -e 's/.*=//' | sed -e 's/"//g'`);
 167
 168     print "Sniffed target: $target, $libver\n";
 169
 170     return ($target, $libver, $lang);
 171 }
 172
 173 sub build_installed_list($)
 174 {
 175     my $path = shift;
 176     my %files = ();
 177
 178     for my $suffix (keys %replaceable) {
 179         my $dirname = "$path/$suffix";
 180         my $dirhandle;
 181         my $pattern = $replaceable{$suffix};
 182         if (opendir ($dirhandle, $dirname)) {
 183             while (my $fname = readdir ($dirhandle)) {
 184                 $fname =~ m/$pattern/ || next;
 185
 186                 my $skip = 0;
 187                 for $pattern (@exceptions) {
 188                     $fname =~ /$pattern/ || next;
 189                     $skip = 1;
 190                 }
 191                 $files{$fname} = $dirname if !$skip;
 192             }
 193             closedir ($dirhandle);
 194         } else {
 195             print "Couldn't find '$dirname': skipping\n";
 196         }
 197     }
 198     return \%files;
 199 }
 200
 201 sub check_create_linked($)
 202 {
 203     my $path = shift;
 204     my $linked_dir = "$path/linked";
 205     if (! -d $linked_dir) {
 206         mkdir $linked_dir || die "Can't make $linked_dir: $!";
 207     }
 208 }
 209
 210 sub do_link($$$$@)
 211 {
 212     my $src = shift;
 213     my $dest = shift;
 214     my $src_name = shift;
 215     my $dest_name = shift;
 216     my $dont_check_link = shift;
 217
 218     if ($copy) { # copy if older ...
 219         my $src_mtime = stat("$src/$src_name")->mtime;
 220         my $dest_mtime = stat("$dest/$dest_name")->mtime;
 221         if ($src_mtime > $dest_mtime) {
 222 #           print " copy $src/$src_name ($src_mtime) -> $dest/$dest_name ($dest_mtime)\n";
 223             print " copy $src/$src_name -> $dest/$dest_name\n";
 224             unlink ("$dest/$dest_name");
 225             copy("$src/$src_name", "$dest/$dest_name") || die "Failed top copy: $!";
 226         } else {
 227 #           print " up-to-date $src/$src_name -> $dest/$dest_name\n";
 228         }
 229     } elsif (-l "$dest/$dest_name" ) {
 230         my $link = readlink ("$dest/$dest_name");
 231         if ($link =~ /^\//) { # Absolute path
 232             if (!$dry_run) {
 233                 # re-write the link
 234                 unlink ("$dest/$dest_name");
 235                 symlink ("$src/$src_name", "$dest/$dest_name") || die "Failed to symlink $src/$src_name: $!";
 236                 print " [$dest_name]";
 237             } else {
 238                 print "re-make link $src/$src_name => $dest/$dest_name\n";
 239             }
 240         } elsif ($dry_run) {
 241             print "skipping symbolic link $dest/$dest_name -> $link\n";
 242         }
 243     } else {
 244         if (!$dry_run) {
 245             # move / write the link
 246             if ($backup) {
 247                 check_create_linked ($dest);
 248                 rename ("$dest/$dest_name", "$dest/linked/$dest_name") ||
 249                     defined $dont_check_link || die "Failed rename of $dest/$dest_name: $!";
 250             } else {
 251                 unlink ("$dest/$dest_name") ||
 252                     defined $dont_check_link || die "Failed remove of $dest/$dest_name: $!";
 253             }
 254             symlink ("$src/$src_name", "$dest/$dest_name") || die "Failed to symlink $src/$src_name: $!";
 255             print " $dest_name";
 256         } else {
 257             print "move / symlink $src/$src_name => $dest/$dest_name\n";
 258         }
 259     }
 260 }
 261
 262 sub scan_one_dir($$$$)
 263 {
 264     my ($installed_files, $build_files, $path, $solver) = @_;
 265     my $dirh_module;
 266
 267     if (!$solver) {
 268         if (opendir ($dirh_module, "$path/..")) {
 269             while (my $file = readdir ($dirh_module)) {
 270                 if ($file =~ /Library_.*\.mk/) {
 271                     if (-d $path) {
 272                         print STDERR "gnu-makeified module contains stale output dir '$path', renaming it away\n";
 273                         rename ($path, "$path.obsolete"); # if it fails, nevermind ...
 274                     }
 275                     return;
 276                 }
 277             }
 278             closedir ($dirh_module);
 279         }
 280     }
 281
 282     for my $elem (@search_dirs) {
 283         my $module_path = "$path/$elem";
 284         if (opendir ($dirh_module, $module_path)) {
 285             while (my $file = readdir ($dirh_module)) {
 286                 if (defined $installed_files->{$file}) {
 287                     if (defined $build_files->{$file}) {
 288                         my $known = 0;
 289                         for my $regexp (@known_duplicates) {
 290                             if ($file =~ m/$regexp/) {
 291                                 $known = 1;
 292                             }
 293                         }
 294                         if (!$known && !$solver) {
 295                             print STDERR "\nlinkoo:: Unknown duplicate file '$file' in: '" .
 296                                 $build_files->{$file} . "' vs '" .
 297                                 $module_path . "' in module $path\n";
 298                             exit (1);
 299                         }
 300                     } else {
 301                         $build_files->{$file} = $module_path;
 302                     }
 303                 }
 304             }
 305         }
 306         closedir ($dirh_module);
 307     }
 308 }
 309
 310 sub get_modules($$)
 311 {
 312     my $build_path = shift;
 313     my $target = shift;
 314
 315     my @modules = ();
 316     my $dirh_toplevel;
 317     opendir ($dirh_toplevel, $build_path) || die "Can't open '$build_path': $!";
 318     while ( my $subdir = readdir ($dirh_toplevel) )
 319     {
 320         $subdir =~ m/\./ && next; # eg. vcl.old,
 321             $subdir eq 'solver' && next; # skip solver dir itself
 322         my $test = "$build_path/$subdir/$target";
 323         -d $test || next;
 324         push @modules, $test;
 325     }
 326     closedir ($dirh_toplevel);
 327
 328     return \@modules;
 329 }
 330
 331 sub scan_and_link_files($$$)
 332 {
 333     my $build_path = shift;
 334     my $installed_files = shift;
 335     my $target = shift;
 336
 337     my @modules = get_modules( $build_path, $target );
 338
 339     # Scan the old-style module/$target/lib directories ...
 340     my %build_files;
 341     for my $module (@modules) {
 342         scan_one_dir ($installed_files, \%build_files, $module, 0);
 343     }
 344
 345     # Now scan the solver
 346     scan_one_dir ($installed_files, \%build_files, "$SOLARVER/$target", 1);
 347
 348     for my $file (keys %build_files) {
 349         my $src = $build_files{$file};
 350         my $dest = $installed_files->{$file};
 351
 352         do_link ($src, $dest, $file, $file);
 353     }
 354     print "\n";
 355 }
 356
 357 sub evilness($)
 358 {
 359     my $doit = shift;
 360     my $name = 'librecentfile.so';
 361     my $src  = "$OOO_BUILD/shell/$TARGET/lib/$name";
 362     my $dest = "$OOO_BUILD/sfx2/$TARGET/lib/$name";
 363
 364     return if ($windows);
 365
 366     if ($doit eq 'undo') {
 367         if (-l $dest) {
 368             print " unlink $name\n";
 369             unlink $dest;
 370         }
 371     } else {
 372         $doit eq 'do' || die;
 373         if (-f $src) {
 374             print " link $name\n";
 375             symlink $src, $dest;
 376         }
 377     }
 378 }
 379
 380 sub do_link_gdb_py($$$)
 381 {
 382     my $srcdir = shift;
 383     my $libdir = shift;
 384     my $loader = shift;
 385
 386     my $lib = $loader =~ s/-gdb.py$//;
 387     my $destdir = $libdir;
 388     # Autoloader for a library is looked for in the same directory the library
 389     # is (the library, not a symlink to it). Therefore it does not help to link
 390     # it from solver into install, because there is only a symlink in install
 391     # anyway. Instead, we must follow the link.
 392     if (-l "$libdir/$lib") {
 393         $destdir = readlink ("$libdir/$lib");
 394         $destdir =~ s@/[^/]*$@@;
 395     }
 396
 397     if ($destdir ne $srcdir) {
 398         do_link ($srcdir, $destdir, $loader, $loader, 1);
 399     }
 400 }
 401
 402 sub link_gdb_py()
 403 {
 404     return if ($windows);
 405     print "Special gdb.py helpers case: ";
 406
 407     my $dirh;
 408     my @basis;
 409     my @ure;
 410     my $src = "$SOLARVER/$TARGET/lib";
 411     opendir ($dirh, $src) || die "can't open solver: $src: $!";
 412     while (my $dent = readdir ($dirh)) {
 413         $dent =~ /^\./ && next;
 414         $dent =~ /\-gdb\.py/ || next;
 415         if ($dent =~ /uno/) {
 416             push @ure, $dent;
 417         } else {
 418             push @basis, $dent;
 419         }
 420     }
 421     closedir ($dirh);
 422     if (@ure < 1 || @basis < 1) {
 423         print STDERR "Warning: missing helpful python debug helpers\n";
 424     } else {
 425         for my $c (@basis) {
 426             do_link_gdb_py ($src, "$OOO_INSTALL/program", $c);
 427         }
 428         for my $c (@ure) {
 429             do_link_gdb_py ($src, "$OOO_INSTALL/ure/lib", $c);
 430         }
 431     }
 432     print "\n";
 433 }
 434
 435 sub link_pagein_files()
 436 {
 437     return if ($windows);
 438
 439     print "pagein case:";
 440     my $src  = "$SOLARVER/$TARGET/bin";
 441     my $dest = "$OOO_INSTALL/" . $brand_program_dir;
 442     for my $c ('calc', 'draw', 'impress', 'writer', 'common') {
 443         do_link ($src, $dest, "pagein-$c", "pagein-$c");
 444     }
 445     print "\n";
 446 }
 447
 448 sub link_ui_files()
 449 {
 450     # First find all the en-US .ui files installed
 451     my @files = ();
 452
 453     find( sub
 454           {
 455               if ( $File::Find::dir !~ /\/res\// && $_ =~ /\.ui$/ )
 456               {
 457                   push( @files, $File::Find::name );
 458               }
 459           }, "$OOO_INSTALL/" );
 460
 461     my @modules = get_modules( $OOO_BUILD, $TARGET );
 462
 463     print "ui case:";
 464     # Search the files in the source tree
 465     for my $dest ( @files )
 466     {
 467         my @dest_dirs = splitdir( $dest );
 468         my $module_dir = @dest_dirs[-3];
 469
 470         my $name = @dest_dirs[-1];
 471         my $nb_dirs = @dest_dirs - 2;
 472         my $dest_dir = catdir( @dest_dirs[0..$nb_dirs] );
 473
 474         # Find out the file to link to in the source tree
 475         my $modulepath = "";
 476         my $nb_segments = 3;
 477         if ( $dest =~ /\/modules\// )
 478         {
 479             # Handle the modules/* cases
 480             if ( $module_dir =~ /^sw/ || $module_dir eq "sglobal" ) { $modulepath = "sw/uiconfig"; }
 481             elsif ( $module_dir eq "smath" ) { $modulepath = "starmath/uiconfig"; }
 482             elsif ( $module_dir eq "simpress" || $module_dir eq "sdraw" ) { $modulepath = "sd/uiconfig"; }
 483             elsif ( $module_dir eq "scalc" ) { $modulepath = "sc/uiconfig"; }
 484             elsif ( $module_dir =~ /^db/ ) { $modulepath = "dbaccess/uiconfig"; }
 485             elsif ( $module_dir eq "BasicIDE" ) { $modulepath = "basctl/uiconfig/basicide"; $nb_segments = 2; }
 486             elsif ( $module_dir eq "schart" ) { $modulepath = "chart2/uiconfig"; $nb_segments = 2; }
 487             elsif ( $module_dir eq "tubes" ) { $modulepath = "tubes/uiconfig"; }
 488             elsif ( $module_dir eq "StartModule" ) { $modulepath = "framework/uiconfig/startmodule"; $nb_segments = 2; }
 489         }
 490         else
 491         {
 492             $nb_segments = 2;
 493             # Handle the <module>/ui/ cases
 494             my $module = $module_dir;
 495             if ( $module_dir eq "sfx" ) { $module = "sfx2"; }
 496             elsif ( $module_dir eq "svt" ) { $module = "svtools"; }
 497             elsif ( $module_dir eq "sw" ) { $module = "sw"; $nb_segments = 3; }
 498             elsif ( $module_dir eq "spa" ) { $module = "padmin"; }
 499             elsif ( $module_dir eq "xmlsec" ) { $module = "xmlsecurity"; }
 500
 501             $modulepath = "$module/uiconfig";
 502         }
 503         my $subpath = catdir( @dest_dirs[-$nb_segments..-2] );
 504         my $src_dir = "$OOO_BUILD/$modulepath/$subpath";
 505
 506 #       print STDERR "$module_dir : $modulepath : '$src_dir/$name'\n";
 507
 508         if ( -e "$src_dir/$name" )
 509         {
 510             do_link ( $src_dir, $dest_dir, $name, $name );
 511         }
 512     }
 513     print "\n";
 514 }
 515
 516 sub link_rdb_files()
 517 {
 518     print "linking rdb:";
 519     my $src_prefix  = "$SOLARVER/$TARGET/";
 520     my $dest_prefix = "$OOO_INSTALL/";
 521
 522     do_link ($src_prefix . "xml" , $dest_prefix . $brand_program_dir . "/services", "services.rdb", "services.rdb");
 523     do_link ($src_prefix . "xml/ure" , $dest_prefix . "ure/share/misc", "services.rdb", "services.rdb");
 524
 525     do_link ($src_prefix . "bin" , $dest_prefix . "ure/share/misc", "udkapi.rdb", "types.rdb");
 526
 527     print "\n";
 528 }
 529
 530 # instdir is an internal directory in the build tree
 531 # installdir is the directory we installed into.
 532 sub do_recursive_link($$)
 533 {
 534     my ($instdir, $installdir) = @_;
 535
 536     (-d $installdir && -d $instdir) || die "not directories";
 537
 538     my $dirhandle;
 539     if (opendir ($dirhandle, $instdir)) {
 540         while (my $fname = readdir ($dirhandle)) {
 541             $fname =~ /^\./ && next;
 542             if (-d "$instdir/$fname") {
 543                 if (-d "$installdir/$fname") {
 544                     do_recursive_link("$instdir/$fname", "$installdir/$fname");
 545                 } else {
 546                     print STDERR "mismatching directories $instdir/$fname vs. $installdir/$fname\n";
 547                 }
 548             } elsif (-f "$installdir/$fname") {
 549                 do_link ($instdir, $installdir, $fname, $fname, 0);
 550             } else {
 551                 print STDERR "Warning: odd file type for $instdir/$fname\n";
 552             }
 553         }
 554     } else {
 555         print STDERR "Couldn't scan '$instdir': $!";
 556     }
 557 }
 558
 559 sub link_instdir($$)
 560 {
 561     my ($instdir, $installdir) = @_;
 562
 563     print "linking instdir ...\n";
 564     for my $dir (@instdir_replaceable) {
 565 # include target ...
 566         do_recursive_link("$instdir/$dir", "$installdir/$dir");
 567     }
 568 }
 569
 570 evilness ('undo');
 571
 572 my $installed_files = build_installed_list ($OOO_INSTALL);
 573
 574 scan_and_link_files ($OOO_BUILD, $installed_files, $TARGET);
 575 link_instdir("$OOO_BUILD/instdir/$TARGET", $OOO_INSTALL);
 576 link_gdb_py();
 577 link_pagein_files();
 578 link_ui_files();
 579 link_rdb_files();
 580
 581 if (!-f "$OOO_INSTALL/" . $brand_program_dir . "/ooenv") {
 582     my $ooenv;
 583     print "Creating '$OOO_INSTALL/", $brand_program_dir, "/ooenv'\n";
 584     open ($ooenv, ">$OOO_INSTALL/" . $brand_program_dir . "/ooenv") || die "Can't open $OOO_INSTALL/" . $brand_program_dir . "/ooenv: $!";
 585     print $ooenv "thisdir=$OOO_INSTALL/" . $brand_program_dir . "/\n";
 586     print $ooenv $env_script;
 587     close ($ooenv);
 588 }
 589
 590 evilness ('do');
 591
 592 print "\nlinkoo finished\n";
 593
 594 # vim:set shiftwidth=4 softtabstop=4 expandtab: