path: root/solenv/bin/linkoo

:
    eval 'exec perl -S $0 ${1+"$@"}'
        if 0;

#
# This file is part of the LibreOffice project.
#
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
#
# This file incorporates work covered by the following license notice:
#
#   Licensed to the Apache Software Foundation (ASF) under one or more
#   contributor license agreements. See the NOTICE file distributed
#   with this work for additional information regarding copyright
#   ownership. The ASF licenses this file to you under the Apache
#   License, Version 2.0 (the "License"); you may not use this file
#   except in compliance with the License. You may obtain a copy of
#   the License at http://www.apache.org/licenses/LICENSE-2.0 .
#
#*************************************************************************
#
#    This app makes it easy to link a live build
# set into an install set. Then your devel iteration
# is: 'build', execute.
#
#*************************************************************************

use strict;
use File::stat;
use File::Copy;
use File::Find;
use File::Spec::Functions qw[splitdir catdir];

# ends up in program/ooenv
( my $moz_lib = `pkg-config --variable=libdir mozilla-nss` ) =~ tr/\n/:/;
my $env_script = '
java_path=`$thisdir/../ure-link/bin/javaldx 2>/dev/null`
export LD_LIBRARY_PATH="$thisdir:$java_path:' . $moz_lib . '$LD_LIBRARY_PATH"
ulimit -c unlimited
export PATH="$thisdir:$thisdir/../ure-link/bin:$PATH"
export GNOME_DISABLE_CRASH_DIALOG=1
# debugging assistance
export SAL_DISABLE_FLOATGRAB=1
export G_SLICE=always-malloc
export MALLOC_CHECK_=2
export MALLOC_PERTURB_=153
export OOO_DISABLE_RECOVERY=1
export SAL_ALLOW_LINKOO_SYMLINKS=1
';

my $dry_run = 0;
my $backup = 0;
my $copy = 0;
my $usage = 0;
my $windows = 0;
my $LANG;
my $TARGET;
my $LIBVER;
my $OOO_BUILD;
my $OOO_INSTALL;
my $SOLARVER;

if ($ENV{'OS'} eq 'MACOSX') {
    print "FIXME: linkoo currently does not work on Mac OS X\n";
    exit(0);
}

# process options
for my $a (@ARGV) {

    # options
    if ($a =~ /--dry-run/) {
        $dry_run = 1;
    } elsif (($a eq '--help') || ($a eq '-h')) {
	$usage = 1;
    } elsif ($a eq '--backup') {
	$backup = 1;
    } elsif ($a eq '--copy') {
	$copy = 1;
    # ordered arguments
    } elsif (!defined $OOO_INSTALL) {
	$OOO_INSTALL = $a;
    } elsif (!defined $OOO_BUILD) {
	$OOO_BUILD = $a;
    } else {
	print "Unknown argument '$a'\n";
	$usage = 1;
    }
}

if (!defined $OOO_BUILD && defined $ENV{SRC_ROOT}) {
    $OOO_BUILD = $ENV{SRC_ROOT};
}

if ($usage || !defined $OOO_INSTALL || !defined $OOO_BUILD) {
    printf "Usage: linkoo </path/to/ooo/install> [</path/to/ooo/build/tree>] [--dry-run] [--backup] [--copy]\n";
    exit (1);
}

File::Spec->file_name_is_absolute($OOO_INSTALL) || die "linkoo requires absolute paths ($OOO_INSTALL does not qualify)";
File::Spec->file_name_is_absolute($OOO_BUILD) || die "linkoo requires absolute paths ($OOO_BUILD does not qualify)";

-d $OOO_INSTALL || die "No such directory $OOO_INSTALL";
-w $OOO_INSTALL || die "You need write access to $OOO_INSTALL";
-d $OOO_BUILD || die "No such directory $OOO_BUILD";

($TARGET, $LIBVER, $LANG) = sniff_target ($OOO_BUILD);

$SOLARVER = "$OOO_BUILD/solver";

if ($TARGET =~ /^wntgcci/ || $TARGET =~ /^wntmsci[0-9]+/) {
    $windows = 1;
}

if ($TARGET =~ /^wntmsci[0-9]+/) {
    # wntgcci means are cross-compiling & can symlink, so copy only on real
    # Windows
    $copy = 1;
}

# setup global variables
my $brand_program_dir = 'program';
my $ure_lib_dir = 'ure-link/lib';
my $win_ure_lib_dir = 'URE/bin';

my @exceptions = ( 'libsunjavaplugin', 'libjvmfwk' );
push @exceptions, 'cppuhelper' if (!$windows);

my $bin;
$bin = "|\\.bin" if ($windows);
my %replaceable = (
    $brand_program_dir => "(\\.so|\\.dll|\\.exe|\\.com$bin)\$",
    $ure_lib_dir => "(\\.so\$|\\.so\\.3\$)",
    $win_ure_lib_dir => "(\\.dll|\\.exe|\\.bin|\\.com)\$",
    $brand_program_dir . '/resource' => '\.res$',
    $brand_program_dir . '/classes' => '\.jar$',
    'ure-link/share/java' => '\.jar$',
    'share/extensions/nlpsolver' => '\.jar$',
    'share/extensions/report-builder' => '\.jar$',
    'share/extensions/wiki-publisher' => '\.jar$',
    'share/extensions/pdf-import' => "(\\.so|\\.dll|\\.exe|\\.com$bin)\$",
    'share/extensions/presenter-screen' => "(\\.so|\\.dll|\\.exe|\\.com$bin)\$",
    'share/extensions/presentation-minimizer' => "(\\.so|\\.dll|\\.exe|\\.com$bin)\$",
    'share/config' => '\.zip$',
#    'share/uno_packages' => '\.zip$'
);

my @search_dirs = ( 'lib', 'bin', 'class' );

my @known_duplicates = ( 'db.jar', 'libi18n', 'libnssckbi', 'libnssdbm', 'libsqlite3', 'libnssutil3', 'pythonloader.uno', 'pyuno', 'libpyuno' );

sub sniff_target($)
{
    my $build_dir = shift;
    my ($target, $libver, $lang) = ( 'unxlngi6.pro', '680', 'en-US' ); # defaults

    chomp($target=`cat $build_dir/config_host.mk | grep INPATH= | sed -e 's/.*=//' | sed -e 's/"//g'`);
    chomp($libver=`cat $build_dir/config_host.mk | grep UPD= | sed -e 's/.*=//' | sed -e 's/"//g'`);

    print "Sniffed target: $target, $libver\n";

    return ($target, $libver, $lang);
}

sub build_installed_list($)
{
    my $path = shift;
    my %files = ();

    for my $suffix (keys %replaceable) {
	my $dirname = "$path/$suffix";
	my $dirhandle;
	my $pattern = $replaceable{$suffix};
	if (opendir ($dirhandle, $dirname)) {
	    while (my $fname = readdir ($dirhandle)) {
		$fname =~ m/$pattern/ || next;

		my $skip = 0;
		for $pattern (@exceptions) {
		    $fname =~ /$pattern/ || next;
		    $skip = 1;
		}
		$files{$fname} = $dirname if !$skip;
	    }
	    closedir ($dirhandle);
	} else {
	    print "Couldn't find '$dirname': skipping\n";
	}
    }
    return \%files;
}

sub check_create_linked($)
{
    my $path = shift;
    my $linked_dir = "$path/linked";
    if (! -d $linked_dir) {
	mkdir $linked_dir || die "Can't make $linked_dir: $!";
    }
}

sub do_link($$$$@)
{
    my $src = shift;
    my $dest = shift;
    my $src_name = shift;
    my $dest_name = shift;
    my $dont_check_link = shift;

    if ($copy) { # copy if older ...
	my $src_mtime = stat("$src/$src_name")->mtime;
	my $dest_mtime = stat("$dest/$dest_name")->mtime;
	if ($src_mtime > $dest_mtime) {
#	    print " copy $src/$src_name ($src_mtime) -> $dest/$dest_name ($dest_mtime)\n";
	    print " copy $src/$src_name -> $dest/$dest_name\n";
	    unlink ("$dest/$dest_name");
	    copy("$src/$src_name", "$dest/$dest_name") || die "Failed top copy: $!";
	} else {
#	    print " up-to-date $src/$src_name -> $dest/$dest_name\n";
	}
    } elsif (-l "$dest/$dest_name" ) {
	my $link = readlink ("$dest/$dest_name");
	if ($link =~ /^\//) { # Absolute path
	    if (!$dry_run) {
		# re-write the link
		unlink ("$dest/$dest_name");
		symlink ("$src/$src_name", "$dest/$dest_name") || die "Failed to symlink $src/$src_name: $!";
		print " [$dest_name]";
	    } else {
		print "re-make link $src/$src_name => $dest/$dest_name\n";
	    }
	} elsif ($dry_run) {
	    print "skipping symbolic link $dest/$dest_name -> $link\n";
	}
    } else {
	if (!$dry_run) {
	    # move / write the link
	    if ($backup) {
		check_create_linked ($dest);
		rename ("$dest/$dest_name", "$dest/linked/$dest_name") ||
		    defined $dont_check_link || die "Failed rename of $dest/$dest_name: $!";
	    } else {
	        unlink ("$dest/$dest_name") ||
		    defined $dont_check_link || die "Failed remove of $dest/$dest_name: $!";
	    }
	    symlink ("$src/$src_name", "$dest/$dest_name") || die "Failed to symlink $src/$src_name: $!";
	    print " $dest_name";
	} else {
	    print "move / symlink $src/$src_name => $dest/$dest_name\n";
	}
    }
}

sub scan_one_dir($$$$)
{
    my ($installed_files, $build_files, $path, $solver) = @_;
    my $dirh_module;

    if (!$solver) {
	if (opendir ($dirh_module, "$path/..")) {
	    while (my $file = readdir ($dirh_module)) {
		if ($file =~ /Library_.*\.mk/) {
		    if (-d $path) {
			print STDERR "gnu-makeified module contains stale output dir '$path', renaming it away\n";
			rename ($path, "$path.obsolete"); # if it fails, nevermind ...
		    }
		    return;
		}
	    }
	    closedir ($dirh_module);
	}
    }

    for my $elem (@search_dirs) {
	my $module_path = "$path/$elem";
	if (opendir ($dirh_module, $module_path)) {
	    while (my $file = readdir ($dirh_module)) {
		if (defined $installed_files->{$file}) {
		    if (defined $build_files->{$file}) {
			my $known = 0;
			for my $regexp (@known_duplicates) {
			    if ($file =~ m/$regexp/) {
				$known = 1;
			    }
			}
			if (!$known && !$solver) {
			    print STDERR "\nlinkoo:: Unknown duplicate file '$file' in: '" .
				$build_files->{$file} . "' vs '" .
				$module_path . "' in module $path\n";
			    exit (1);
			}
		    } else {
			$build_files->{$file} = $module_path;
		    }
		}
	    }
	}
	closedir ($dirh_module);
    }
}

sub get_modules($$)
{
    my $build_path = shift;
    my $target = shift;

    my @modules = ();
    my $dirh_toplevel;
    opendir ($dirh_toplevel, $build_path) || die "Can't open '$build_path': $!";
    while ( my $subdir = readdir ($dirh_toplevel) )
    {
        $subdir =~ m/\./ && next; # eg. vcl.old,
            $subdir eq 'solver' && next; # skip solver dir itself
        my $test = "$build_path/$subdir/$target";
        -d $test || next;
        push @modules, $test;
    }
    closedir ($dirh_toplevel);

    return \@modules;
}

sub scan_and_link_files($$$)
{
    my $build_path = shift;
    my $installed_files = shift;
    my $target = shift;

    my @modules = get_modules( $build_path, $target );

    # Scan the old-style module/$target/lib directories ...
    my %build_files;
    for my $module (@modules) {
	scan_one_dir ($installed_files, \%build_files, $module, 0);
    }

    # Now scan the solver
    scan_one_dir ($installed_files, \%build_files, "$SOLARVER/$target", 1);

    for my $file (keys %build_files) {
	my $src = $build_files{$file};
	my $dest = $installed_files->{$file};

	do_link ($src, $dest, $file, $file);
    }
    print "\n";
}

sub evilness($)
{
    my $doit = shift;
    my $name = 'librecentfile.so';
    my $src  = "$OOO_BUILD/shell/$TARGET/lib/$name";
    my $dest = "$OOO_BUILD/sfx2/$TARGET/lib/$name";

    return if ($windows);

    if ($doit eq 'undo') {
	if (-l $dest) {
	    print " unlink $name\n";
	    unlink $dest;
	}
    } else {
	$doit eq 'do' || die;
        if (-f $src) {
	    print " link $name\n";
	    symlink $src, $dest;
	}
    }
}

sub do_link_gdb_py($$$)
{
    my $srcdir = shift;
    my $libdir = shift;
    my $loader = shift;

    my $lib = $loader =~ s/-gdb.py$//;
    my $destdir = $libdir;
    # Autoloader for a library is looked for in the same directory the library
    # is (the library, not a symlink to it). Therefore it does not help to link
    # it from solver into install, because there is only a symlink in install
    # anyway. Instead, we must follow the link.
    if (-l "$libdir/$lib") {
        $destdir = readlink ("$libdir/$lib");
        $destdir =~ s@/[^/]*$@@;
    }

    if ($destdir ne $srcdir) {
        do_link ($srcdir, $destdir, $loader, $loader, 1);
    }
}

sub link_gdb_py()
{
    return if ($windows);
    print "Special gdb.py helpers case: ";

    my $dirh;
    my @basis;
    my @ure;
    my $src = "$SOLARVER/$TARGET/lib";
    opendir ($dirh, $src) || die "can't open solver: $src: $!";
    while (my $dent = readdir ($dirh)) {
	$dent =~ /^\./ && next;
	$dent =~ /\-gdb\.py/ || next;
	if ($dent =~ /uno/) {
	    push @ure, $dent;
	} else {
	    push @basis, $dent;
	}
    }
    closedir ($dirh);
    if (@ure < 1 || @basis < 1) {
	print STDERR "Warning: missing helpful python debug helpers\n";
    } else {
	for my $c (@basis) {
	    do_link_gdb_py ($src, "$OOO_INSTALL/program", $c);
	}
	for my $c (@ure) {
	    do_link_gdb_py ($src, "$OOO_INSTALL/ure/lib", $c);
	}
    }
    print "\n";
}

sub link_pagein_files()
{
    return if ($windows);

    print "pagein case:";
    my $src  = "$SOLARVER/$TARGET/bin";
    my $dest = "$OOO_INSTALL/" . $brand_program_dir;
    for my $c ('calc', 'draw', 'impress', 'writer', 'common') {
	do_link ($src, $dest, "pagein-$c", "pagein-$c");
    }
    print "\n";
}

sub link_ui_files()
{
    # First find all the en-US .ui files installed
    my @files = ();

    find( sub
          {
              if ( $File::Find::dir !~ /\/res\// && $_ =~ /\.ui$/ )
              {
                  push( @files, $File::Find::name );
              }
          }, $OOO_INSTALL );

    my @modules = get_modules( $OOO_BUILD, $TARGET );

    print "ui case:";
    # Search the files in the source tree
    for my $dest ( @files )
    {
        my @dest_dirs = splitdir( $dest );
        my $module_dir = @dest_dirs[-3];

        my $name = @dest_dirs[-1];
        my $nb_dirs = @dest_dirs - 2;
        my $dest_dir = catdir( @dest_dirs[0..$nb_dirs] );

        # Find out the file to link to in the source tree
        my $modulepath = "";
        my $nb_segments = 3;
        if ( $dest =~ /\/modules\// )
        {
            # Handle the modules/* cases
            if ( $module_dir =~ /^sw/ || $module_dir eq "sglobal" ) { $modulepath = "sw/uiconfig"; }
            elsif ( $module_dir eq "smath" ) { $modulepath = "starmath/uiconfig"; }
            elsif ( $module_dir eq "simpress" || $module_dir eq "sdraw" ) { $modulepath = "sd/uiconfig"; }
            elsif ( $module_dir eq "scalc" ) { $modulepath = "sc/uiconfig"; }
            elsif ( $module_dir =~ /^db/ ) { $modulepath = "dbaccess/uiconfig"; }
            elsif ( $module_dir eq "BasicIDE" ) { $modulepath = "basctl/uiconfig/basicide"; $nb_segments = 2; }
            elsif ( $module_dir eq "schart" ) { $modulepath = "chart2/uiconfig"; $nb_segments = 2; }
            elsif ( $module_dir eq "tubes" ) { $modulepath = "tubes/uiconfig"; }
            elsif ( $module_dir eq "StartModule" ) { $modulepath = "framework/uiconfig/startmodule"; $nb_segments = 2; }
        }
        else
        {
            $nb_segments = 2;
            # Handle the <module>/ui/ cases
            my $module = $module_dir;
            if ( $module_dir eq "sfx" ) { $module = "sfx2"; }
            elsif ( $module_dir eq "svt" ) { $module = "svtools"; }
            elsif ( $module_dir eq "sw" ) { $module = "sw"; $nb_segments = 3; }

            $modulepath = "$module/uiconfig";
        }
        my $subpath = catdir( @dest_dirs[-$nb_segments..-2] );
        my $src_dir = "$OOO_BUILD/$modulepath/$subpath";

        if ( -e "$src_dir/$name" )
        {
            do_link ( $src_dir, $dest_dir, $name, $name );
        }
    }
    print "\n";
}

evilness ('undo');

my $installed_files = build_installed_list ($OOO_INSTALL);

scan_and_link_files ($OOO_BUILD, $installed_files, $TARGET);
link_gdb_py();
link_pagein_files();
link_ui_files();

if (!-f "$OOO_INSTALL/" . $brand_program_dir . "/ooenv") {
    my $ooenv;
    print "Creating '$OOO_INSTALL/", $brand_program_dir, "/ooenv'\n";
    open ($ooenv, ">$OOO_INSTALL/" . $brand_program_dir . "/ooenv") || die "Can't open $OOO_INSTALL/" . $brand_program_dir . "/ooenv: $!";
    print $ooenv "thisdir=$OOO_INSTALL/" . $brand_program_dir . "/\n";
    print $ooenv $env_script;
    close ($ooenv);
}

evilness ('do');

print "\nlinkoo finished\n";

# vim:set shiftwidth=4 softtabstop=4 expandtab: