openbsd-ports/infrastructure/build/libtool

#!/usr/bin/perl
# $OpenBSD: libtool,v 1.56 2008/11/09 10:30:54 steven Exp $

# Copyright (c) 2007-2008 Steven Mestdagh <steven@openbsd.org>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

use strict;
use warnings;
use feature qw(say switch state);
use Cwd qw(getcwd abs_path);
use File::Basename;
use File::Glob ':glob';
use File::Path;
use Getopt::Long;
use Getopt::Std;

package main;

use subs qw(
	create_symlinks
	find_la
	find_lib
	generate_objlist
	get_search_dirs
	guess_implicit_mode
	handle_special_chars
	help
	is_prog_wrapper
	linkcmd
	notyet
	parse_linkargs_list
	parse_version_info
	process_deplibs
	resolve_la_list
	reverse_zap_duplicates
	reverse_zap_duplicates_ref
	write_prog_wrapper
	);

package Trace;

sub print(&)
{
	my $val = shift;
	if (defined $ENV{'TRACE_LIBTOOL'}) {
		state $trace_file;
		if (!defined $trace_file) {
			open $trace_file, '>>', $ENV{'TRACE_LIBTOOL'};
		}
		if (defined $trace_file) {
			print $trace_file (&$val);
		}
	}
}

sub debug(&;$)
{
	my ($args, $level) = @_;

	$level = 1 if !defined $level;

	if (defined $main::D && $main::D >= $level) {
		print (&$args);
	}
}

{
package Exec;

my $dry = 0;
my $verbose = 0;
my $performed = 0;

sub performed
{
	return $performed;
}

sub dry_run
{
	$dry = 1;
}

sub verbose_run
{
	$verbose = 1;
}

sub new
{
	my $class = shift;
	bless {}, $class;
}

sub chdir
{
	my ($self, $dir) = @_;
	my $class = ref($self) || $self;
	bless {dir => $dir}, $class;
}


sub command_run
{
	my ($self, @l) = @_;

	if ($self->{dir}) {
		Trace::print {"cd $self->{dir} && "};
	}
	Trace::print { "@l\n" };
	my $pid = fork();
	if ($pid == -1) {
		die "Couldn't fork while running @l\n";
	}
	if ($pid == 0) {
		if ($self->{dir}) {
			CORE::chdir($self->{dir}) or die "Can't chdir to $self->{dir}\n";
		}
		exec(@l);
		die "Exec failed @l\n";
	} else {
		my $kid = waitpid($pid, 0);
		if ($? != 0) {
			die "Error while executing @l\n";
		}
	}
}

sub shell
{
	my ($self, @cmds) = @_;
	# create an object "on the run"
	if (!ref($self)) {
		$self = $self->new;
	}
	for my $c (@cmds) {
		say $c if $verbose || $dry;
		if (!$dry) {
			$self->command_run($c);
	        }
	}
	$performed++;
}

sub command
{
	my ($self, @l) = @_;
	# create an object "on the run"
	if (!ref($self)) {
		$self = $self->new;
	}
	say @l if $verbose || $dry;
	if (!$dry) {
		$self->command_run(@l);
	}
	$performed++;
}
}

package LaLoFile;
my %file_cache;		# which files have been parsed
my $cache_by_fullname = {};
my $cache_by_inode = {};

# allows special treatment for some keywords
sub set
{
	my ($self, $k, $v) = @_;

	$self->{$k} = $v;
}

sub stringize
{
	my ($self, $k) = @_;
	return $self->{$k} || '';
}

sub read
{
	my ($class, $filename) = @_;
	my $info = $class->new;
	open(my $fh, '<', $filename) or die "cannot read $filename: $!\n";
	my $_;
	while (<$fh>) {
		chomp;
		next if /^\#/;
		next if /^\s*$/;
		if (m/^(\S+)\=\'(.*)\'$/) {
			$info->set($1, $2);
		} elsif (m/^(\S+)\=(\S+)$/) {
			$info->set($1, $2);
		}
	}
	return $info;
}

sub parse
{
	my ($class, $filename) = @_;

	Trace::debug {"parsing $filename"};

	if (defined $cache_by_fullname->{$filename}) {
		Trace::debug {" (cached)\n"};
		return $cache_by_fullname->{$filename};
	}
	my $key = join("/", (stat $filename)[0,1]);
	if (defined $cache_by_inode->{$key}) {
		Trace::debug {" (cached)\n"};
		return $cache_by_inode->{$key};
	}
	Trace::debug {"\n"};
	return $cache_by_inode->{$key} = $cache_by_fullname->{$filename} =
	    $class->read($filename);
}

sub new
{
	my $class = shift;
	bless {}, $class;
}

package LaFile;
our @ISA=(qw(LaLoFile));
use File::Basename;

# allows special treatment for some keywords
sub set
{
	my ($self, $k, $v) = @_;

	$self->SUPER::set($k, $v);
	if ($k eq 'dependency_libs') {
		my @l = split /\s+/, $v;
		$self->{deplib_list} = \@l;
	}
}

sub deplib_list
{
	my $self = shift;
	return $self->{deplib_list}
}

# XXX not sure how much of this cruft we need
sub write
{
	my ($lainfo, $filename, $name) = @_;

	my $libname = $lainfo->stringize('libname');
	my $sharedlibname = $lainfo->stringize('dlname');
	my $staticlibname = $lainfo->stringize('old_library');
	my $librarynames = $lainfo->stringize('library_names');
	my $deplibs = $lainfo->stringize('dependency_libs');
	my $current = $lainfo->stringize('current');
	my $revision = $lainfo->stringize('revision');
	my $age = $lainfo->stringize('age');
	my $installed = $lainfo->stringize('installed');
	my $shouldnotlink = $lainfo->stringize('shouldnotlink');
	my $libdir = $lainfo->stringize('libdir');

	open(my $la, '>', $filename) or die "cannot write $filename: $!\n";
	say "creating $filename" if $main::verbose || $main::D;
	print $la <<EOF
# $name - libtool library file
# Generated by libtool $main::version
#
# Please DO NOT delete this file!
# It is necessary for linking the library.

# The name that we can dlopen(3).
dlname='$sharedlibname'

# Names of this library.
library_names='$librarynames'

# The name of the static archive.
old_library='$staticlibname'

# Libraries that this one depends upon.
dependency_libs='$deplibs'

# Version information for $libname.
current=$current
age=$age
revision=$revision

# Is this an already installed library?
installed=$installed

# Should we warn about portability when linking against -modules?
shouldnotlink=$shouldnotlink

# Files to dlopen/dlpreopen
dlopen=''
dlpreopen=''

# Directory that this library needs to be installed in:
libdir='$libdir'
EOF
;
}


package LoFile;
our @ISA=(qw(LaLoFile));
use File::Basename;

# write a libtool object file
sub write
{
	my ($self, $filename) = @_;
	my $picobj = $self->stringize('picobj');
	my $nonpicobj = $self->stringize('nonpicobj');

	my $name = basename $filename;

	open(my $lo, '>', $filename) or die "cannot write $filename: $!\n";
	say "creating $filename" if $main::verbose || $main::D;
	print $lo <<EOF
# $name - a libtool object file
# Generated by libtool $main::version
#
pic_object='$picobj'
non_pic_object='$nonpicobj'
EOF
;
}


package main;

use constant {
	OBJECT	=> 0,
	LIBRARY	=> 1,
	PROGRAM	=> 2,
};

my $calls = 0;
our $version = '1.5.26'; # pretend to be this version of libtool
my @no_shared_archs = qw(m88k vax sh);
# XXX my $machine_arch = `machine -a`;
my $machine_arch = 'amd64';
(my $gnu_arch = $machine_arch) =~ s/amd64/x86_64/;
my @valid_modes = qw(clean compile execute finish install link uninstall);
my @valid_src = qw(asm c cc cpp cxx f s);
my $cwd = getcwd();
my $ltdir = '.libs';
my $picflags = '-fPIC -DPIC';
my $sharedflag = '-shared';
my $instlibdir = '/usr/local/lib';
my @libsearchdirs;
$instlibdir = $ENV{'LIBDIR'} if defined $ENV{'LIBDIR'};

my $mode;
our $D = 0;		# debug flag
my $verbose = 1;

my %opts;		# options passed to libtool
my @Ropts;		# -R options on the command line
my @Rresolved;		# -R options originating from .la resolution
my @RPopts;		# -rpath options
my @tags;		# list of --tag options passed to libtool
my @deplibs;		# list of dependent libraries (both -L and -l flags)
my %libs;		# libraries
my %libstofind;
my @orderedlibs;	# ordered library keys (may contain duplicates)
my %dirs;		# paths to find libraries

# just to be clear:
# when building a library:
# 	* -R libdir records libdir in dependency_libs
# 	* -rpath is the path where the (shared) library will be installed
# when building a program:
# 	* both -R libdir and -rpath libdir add libdir to the run-time path
# -Wl,-rpath,libdir will bypass libtool.

# build static/shared objects?
my $static = 1;
my $shared = 0;
my $noshared = 0;
if (grep { $_ eq $machine_arch } @no_shared_archs) {
	$noshared = 1;
}

# put a priority in the dir hash
# always look here
$dirs{'/usr/lib'} = 3;

my $gp = new Getopt::Long::Parser;
# require_order so we stop parsing at the first non-option or argument,
# instead of parsing the whole ARGV.
$gp->configure(	'no_ignore_case',
		'pass_through',
		'no_auto_abbrev',
		'require_order'
	);
$gp->getoptions('config' => \&config,
		'debug' => \$D,
		'dry-run|n' => sub { Exec->dry_run },
		'features' => \&features,
		'finish' => sub { $mode = 'finish'; },
		'help' => \&help, # does not return
		'mode=s{1}' => \$mode,
		'quiet' => sub { $verbose = 0; },
		'silent' => sub { $verbose = 0; },
		'tag=s{1}' => \@tags,
		'version' => sub { say $version ; exit(0); },
	);

if ($verbose || $D) {
	Exec->verbose_run;
}
# what are we going to run (cc, c++, ...)
my $ltprog = shift @ARGV or die "no libtool command\n";

# check mode and guess it if needed
if (!($mode && grep { $_ eq $mode } @valid_modes)) {
	$mode = guess_implicit_mode();
	if ($mode) {
		Trace::debug {"implicit mode: $mode\n"};
	} else {
		die "MODE must be one of:\n@valid_modes\n";
	}
}

# from here, options may be intermixed with arguments
$gp->configure('permute');

#print "\n###\n### WARNING: ",
#	"This version of libtool is EXPERIMENTAL. ###\n###\n\n";

if ($mode eq 'compile') {
	# deal with multi-arg ltprog
	while (@ARGV && $ltprog !~ m/(cc|c\+\+|f77|g77|asm)$/) {
		my $arg = shift @ARGV;
		$ltprog .= " $arg";
	}
	$gp->getoptions('o=s'		=> \$opts{'o'},
			'prefer-pic'	=> \$opts{'prefer-pic'},
			'prefer-non-pic'=> \$opts{'prefer-non-pic'},
			'static'	=> \$opts{'static'},
			);
	# XXX options ignored: -prefer-pic and -prefer-non-pic
	my $cmd;
	my $pic = 0;
	my $nonpic = 1;
	# assume we need to build pic objects
	$pic = 1 if (!$noshared);
	$nonpic = 0 if ($pic && grep { $_ eq 'disable-static' } @tags);
	$pic = 0 if ($nonpic && grep { $_ eq 'disable-shared' } @tags);
	$nonpic = 1 if ($opts{'static'});

	my ($outfile, $odir, $ofile, $srcfile, $srcext);
	# XXX check whether -c flag is present and if not, die?
	if ($opts{'o'}) {
		$outfile = $opts{'o'};
		# fix extension if needed
		$outfile =~ s/\.o$/.lo/;
		$odir = dirname $outfile;
		$ofile = basename $outfile;
	} else {
		# XXX sometimes no -o flag is present and we need another way
		my $srcre = join '|', @valid_src;
		my $found = 0;
		foreach my $a (@ARGV) {
			if ($a =~ m/\.($srcre)$/i) {
				$srcfile = $a;
				$srcext = $1;
				$found = 1;
				last;
			}
		}
		$found or die "cannot find source file in command\n";
		# the output file ends up in the current directory
		$odir = '.';
		$ofile = basename $srcfile;
		$ofile =~ s/\.($srcext)$/.lo/i;
		$outfile = "$odir/$ofile";
	}
	Trace::debug {"srcfile = $srcfile\n"} if $srcfile;
	Trace::debug {"outfile = $outfile\n"};
	(my $nonpicobj = $ofile) =~ s/\.lo$/.o/;
	my $picobj = "$ltdir/$nonpicobj";

	handle_special_chars(\@ARGV);

	mkdir "$odir/$ltdir" if (! -d "$odir/$ltdir");
	if ($pic) {
		$cmd = $ltprog;
		$cmd .= " @ARGV" if (@ARGV);
		$cmd .= " $picflags";
		$cmd .= " -o ";
		$cmd .= ($odir eq '.') ? '' : $odir.'/';
		$cmd .= $picobj;
		Exec->shell($cmd);
	}
	if ($nonpic) {
		$cmd = $ltprog;
		$cmd .= " @ARGV" if (@ARGV);
		$cmd .= " -o ";
		$cmd .= ($odir eq '.') ? '' : $odir.'/';
		$cmd .= $nonpicobj;
		Exec->shell($cmd);
	}
	my $lofile = LoFile->new;
	$lofile->{picobj} = $picobj if $pic;
	$lofile->{nonpicobj} = $nonpicobj if $nonpic;
	$lofile->write($outfile);
} elsif ($mode eq 'install') {
	# deal with multi-arg ltprog (e.g. /bin/sh install-sh ...)
	while (@ARGV && $ltprog !~ m/(install([.-]sh)?|cp)$/) {
		my $arg = shift @ARGV;
		$ltprog .= " $arg";
	}
	# we just parse the options in order to find the actual arguments
	my @argvcopy = @ARGV;
	my %install_opts;
	if ($ltprog =~ m/install([.-]sh)?$/) {
		getopts('BbCcdf:g:m:o:pSs', \%install_opts);
		if (@ARGV < 2 && (!defined $install_opts{'d'} && @ARGV == 1)) {
			die "wrong number of arguments for install\n";
		}
	} elsif ($ltprog =~ m/cp$/) {
		getopts('HLPRfipr', \%install_opts);
		if (@ARGV < 2) {
			die "wrong number of arguments for install\n";
		}
	} else {
		die "unsupported install program $ltprog\n";
	}
	my @instopts = @argvcopy[0 .. (@argvcopy - @ARGV - 1)];
	my $dst = pop @ARGV;
	my @src = @ARGV;
	my $dstdir;
	if (-d $dst) {
		$dstdir = $dst;
	} else {
		# dst is not a directory, i.e. a file
		if (@src > 1) {
			# XXX not really libtool's task to check this
			die "multiple source files combined with file destination";
		} else {
			$dstdir = dirname $dst;
		}
	}
	my %toinstall;
	my %tosymlink;	# for libraries with a -release in their name
	foreach my $s (@src) {
		my $dstfile = basename $s;
		# resolve symbolic links, so we don't try to test later
		# whether the symlink is a program wrapper etc.
		if (-l $s) {
			$s = readlink($s) or die "Cannot readlink $s";
		}
		my $srcdir = dirname $s;
		my $srcfile = basename $s;
		Trace::debug {"srcdir = $srcdir\nsrcfile = $srcfile\n"};
		Trace::debug {"dstdir = $dstdir\ndstfile = $dstfile\n"};
		if ($srcfile =~ m/^\S+\.la$/) {
			# we are installing a .la library
			if ($ltprog =~ m/install([.-]sh)?$/) {
				push @instopts, '-m 644';
			}
			my $lainfo = LaFile->parse($s);
			# replace info where needed when installing the .la file
			my $sharedlib = $lainfo->{'dlname'};
			my $staticlib = $lainfo->{'old_library'};
			my @libnames = split /\s+/, $lainfo->{'library_names'};
			my $laipath = "$srcdir/$ltdir/$srcfile".'i';
			$toinstall{"$srcdir/$ltdir/$staticlib"} = "$dstdir/$staticlib"
				if ($staticlib);
			$toinstall{"$srcdir/$ltdir/$sharedlib"} = "$dstdir/$sharedlib"
				if ($sharedlib);
			$toinstall{"$laipath"} = "$dstdir/$dstfile"
				if ($sharedlib);
			foreach my $n (@libnames) {
				$tosymlink{$n} = $sharedlib if ($n ne $sharedlib);
			}
		} elsif (-f "$srcdir/$ltdir/$srcfile" && is_prog_wrapper($s)) {
			$toinstall{"$srcdir/$ltdir/$srcfile"} = $dst;
		} else {
			$toinstall{$s} = $dst;
		}
	}
	while (my ($s, $d) = each %toinstall) {
		my @realinstopts = @instopts;
		# do not try to strip .la files
		if ($s =~ m/\.la$/ || $d =~ m /\.la$/) {
			map { $_ = '' if $_ eq '-s' } @realinstopts;
		}
		Exec->shell("$ltprog @realinstopts $s $d");
	}
	while (my ($d, $s) = each %tosymlink) {
		unlink("$dstdir/$d");
		symlink($s, "$dstdir/$d");
	}
	if (defined $install_opts{'d'}) {
		Exec->shell("$ltprog @instopts @ARGV");
	}
} elsif ($mode eq 'link') {
	my $cmd;
	$gp->getoptions('all-static'		=> \$opts{'all-static'},
			'avoid-version'		=> \$opts{'avoid-version'},
			'dlopen=s{1}'		=> \$opts{'dlopen'},
			'dlpreopen=s{1}'	=> \$opts{'dlpreopen'},
			'export-dynamic'	=> \$opts{'export-dynamic'},
			'export-symbols=s'	=> \$opts{'export-symbols'},
			'export-symbols-regex=s'=> \$opts{'export-symbols-regex'},
			'module'		=> \$opts{'module'},
			'no-fast-install'	=> \$opts{'no-fast-install'},
			'no-install'		=> \$opts{'no-install'},
			'no-undefined'		=> \$opts{'no-undefined'},
			'o=s'			=> \$opts{'o'},
			'objectlist=s'		=> \$opts{'objectlist'},
			'precious-files-regex=s'=> \$opts{'precious-files-regex'},
			'prefer-pic'		=> \$opts{'prefer-pic'},
			'prefer-non-pic'	=> \$opts{'prefer-non-pic'},
			'release=s'		=> \$opts{'release'},
			'rpath=s'		=> \@RPopts,
			'R=s'			=> \@Ropts,
			'shrext=s'		=> \$opts{'shrext'},
			'static'		=> \$opts{'static'},
			'thread-safe'		=> \$opts{'thread-safe'},
			'version-info=s{1}'	=> \$opts{'version-info'},
			'version_info=s{1}'	=> \$opts{'version-info'},
			'version-number=s{1}'	=> \$opts{'version-info'},
		);
	# XXX options ignored: dlopen, dlpreopen, no-fast-install,
	# 	no-install, no-undefined, precious-files-regex,
	# 	shrext, thread-safe, prefer-pic, prefer-non-pic

	@libsearchdirs = get_search_dirs();
	# add the .libs dir as well in case people try to link directly
	# with the real library instead of the .la library
	push @libsearchdirs, './.libs';

	my $outfile = $opts{'o'};
	if (!$outfile) {
		die "no output file given.\n";
	}
	Trace::debug {"outfile = $outfile\n"};
	my $odir = dirname $outfile;
	my $absodir = abs_path($odir);
	my $ofile = basename $outfile;

	# what are we linking?
	my $linkmode = PROGRAM;
	if ($ofile =~ m/\.la$/) {
		$linkmode = LIBRARY;
	} elsif ($ofile =~ s/\.a$/.la/) {
		$outfile =~ s/\.a$/.la/;
		$linkmode = LIBRARY;
		$noshared = 1; $static = 1; # XXX improve!
	}
	Trace::debug {"linkmode: $linkmode\n"};

	handle_special_chars(\@ARGV);

	my $args = parse_linkargs_list(\@ARGV, 1);
	@ARGV = @$args;
	Trace::debug {"deplibs = @deplibs\n"};

	# eat multiple version-info arguments, we only accept the first.
	map { $_ = '' if ($_ =~ m/\d+:\d+:\d+/); } @ARGV;

	my @objs;
	my @sobjs;
	my $allpicobj;
	if ($opts{'objectlist'}) {
		my $objectlist = $opts{'objectlist'};
		open(my $ol, '<', $objectlist) or die "cannot open $objectlist: $!\n";
		my @objlist = <$ol>;
		for (@objlist) { chomp; } 
		$allpicobj = generate_objlist(\@objs, \@sobjs, \@objlist);
	} else {
		$allpicobj = generate_objlist(\@objs, \@sobjs, \@ARGV);
	}
	Trace::debug {"objs = @objs\n"};
	Trace::debug {"sobjs = @sobjs\n"};

	if ($linkmode == PROGRAM) {
		# XXX give higher priority to dirs of not installed libs
		# XXX no static linking yet here
		if ($opts{'export-dynamic'}) {
			push(@ARGV, "-Wl,-E");
		}
		my $objlist = \@objs;
		if (@objs == 0) {
		        if (@sobjs > 0) {
				Trace::debug {"no non-pic libtool objects found, trying pic objects...\n"};
				$objlist = \@sobjs;
			} elsif (@sobjs == 0) {
				Trace::debug {"no libtool objects of any kind found\n"};
				Trace::debug {"hoping for real objects in ARGV...\n"};
			}
		}
		my @tmpcmd = linkcmds($ofile, $ofile, $odir, PROGRAM, 1, $objlist);
		$cmd = $tmpcmd[0];
		Exec->shell($cmd);
		write_prog_wrapper($outfile);
		chmod 0755, $outfile;
	} elsif ($linkmode == LIBRARY) {
		(my $libname = $ofile) =~ s/\.la$//;	# remove extension
		my $staticlib = $libname.'.a';
		my $sharedlib = $libname.'.so';
		my $sharedlib_symlink;

		# XXX how is the creation of a shared library switched on?
		# XXX to do: deal with -rpath correctly
		$shared = 1 if ($opts{'version-info'} ||
				$opts{'avoid-version'} ||
				$opts{'module'} ||
				@RPopts);
		if ($opts{'static'} || !@RPopts) {
			$shared = 0;
			$static = 1;
		}
		$shared = 0 if $noshared;
		my $sover = '0.0';
		# environment overrides -version-info
		(my $envlibname = $libname) =~ s/[.+-]/_/g;
		my ($current, $revision, $age) = (0, 0, 0);
		if ($ENV{"${envlibname}_ltversion"}) {
			$sover = $ENV{"${envlibname}_ltversion"};
			($current, $revision) = split /\./, $sover;
			$age = 0;
		} elsif ($opts{'version-info'}) {
			($current, $revision, $age) = parse_version_info($opts{'version-info'});
			$sover = "$current.$revision";
		}
		if ($opts{'release'}) {
			$sharedlib_symlink = $sharedlib;
 			$sharedlib = $libname.'-'.$opts{'release'}.'.so';
		}
		if (!$opts{'avoid-version'}) {
			$sharedlib .= ".$sover";
			if ($opts{'release'}) {
				$sharedlib_symlink .= ".$sover";
			}
		}

		# XXX add error condition somewhere...
		$static = 0 if ($shared && grep { $_ eq 'disable-static' } @tags);
		$shared = 0 if ($static && grep { $_ eq 'disable-shared' } @tags);

		Trace::debug {"SHARED: $shared\nSTATIC: $static\n"};

		my $lainfo = LaFile->new;
		$lainfo->{'libname'} = $libname;
		if ($shared) {
			$lainfo->{'dlname'} = $sharedlib;
			$lainfo->{'library_names'} = $sharedlib;
			$lainfo->{'library_names'} .= " $sharedlib_symlink"
				if ($opts{'release'});
			Exec->shell(linkcmds($ofile, $sharedlib, $odir, LIBRARY, 1, \@sobjs));
			Trace::debug {"sharedlib: $sharedlib\n"};
			$lainfo->{'current'} = $current;
			$lainfo->{'revision'} = $revision;
			$lainfo->{'age'} = $age;
		}
		if ($static) {
			$lainfo->{'old_library'} = $staticlib;
			Exec->shell(linkcmds($ofile, $staticlib, $odir, LIBRARY, 0, ($allpicobj) ? \@sobjs : \@objs));
			Trace::debug {"staticlib: $staticlib\n"};
		}
		$lainfo->{'installed'} = 'no';
		$lainfo->{'shouldnotlink'} = $opts{'module'} ? 'yes' : 'no';
		map { $_ = "-R$_" } @Ropts;
		unshift @deplibs, @Ropts if (@Ropts);
		Trace::debug {"deplibs = @deplibs\n"};
		my $finaldeplibs = reverse_zap_duplicates_ref(\@deplibs);
		Trace::debug {"finaldeplibs = @$finaldeplibs\n"};
		$lainfo->set('dependency_libs', "@$finaldeplibs");
		if (@RPopts) {
			if (@RPopts > 1) {
				Trace::debug {"more than 1 -rpath option given, taking the first: ", $RPopts[0], "\n"};
			}
			$lainfo->{'libdir'} = $RPopts[0];
		}
		$lainfo->write($outfile, $ofile);
		unlink("$odir/$ltdir/$ofile");
		symlink("../$ofile", "$odir/$ltdir/$ofile");
		if ($shared) {
			my $lai = "$odir/$ltdir/$ofile".'i';
			my $pdeplibs = process_deplibs($finaldeplibs);
			$lainfo->set('dependency_libs', "@$pdeplibs");
			$lainfo->{'installed'} = 'yes';
			# write .lai file (.la file that will be installed)
			$lainfo->write($lai, $ofile);
		}
	}
} elsif ($mode eq 'finish' || $mode eq 'clean' || $mode eq 'uninstall') {
	# don't do anything
	exit 0;
} elsif ($mode eq 'execute') {
	# XXX check whether this is right
	Exec->shell("$ltprog @ARGV");
} else {
	die "MODE=$mode not implemented yet.\n";
}

if (Exec->performed == 0) {
	die "no commands to execute.\n"
}

###########################################################################

sub help
{
	print <<EOF
Usage: $0 [options]
--debug	- turn on debugging output
--dry-run - don't do anything, only show what would be done
--help - this message
--mode=MODE - use operation mode MODE
--quiet - do not print informational messages
--silent - same as `--quiet'
--tag - 
--version - print version of libtool
EOF
;
	exit 1;
}

sub notyet
{
	die "option not implemented yet.\n";
}

# convert 4:5:8 into a list of numbers
sub parse_version_info
{
	my $vinfo = shift;

	if ($vinfo =~ m/(\d+):(\d+):(\d+)/) {
		return ($1, $2, $3);
	} else {
		die "error parsing -version-info $vinfo\n";
	}
}

sub create_symlinks
{
	my $dir = shift;
	my $libfiles = shift;

	if (! -d $dir) {
		mkdir $dir or die "cannot create directory: $!\n";
	}
	foreach my $f (@$libfiles) {
		next if ($f =~ m/\.a$/);
		my $libfile = basename $f;
		Trace::debug {"ln -s $f $dir/$libfile\n"};
		if (! -f "$dir/$libfile") {
			symlink abs_path($f), "$dir/$libfile" or die "cannot create symlink: $!\n";
		}
	}
}

# write a wrapper script for an executable so it can be executed within
# the build directory
sub write_prog_wrapper
{
	my $program = shift;

	open(my $pw, '>', $program) or die "cannot write $program: $!\n";
	print $pw <<EOF
#!/bin/sh

# $program - wrapper for $ltdir/$program
# Generated by libtool $version

argdir=`dirname \$0`
if test -f "\$argdir/$ltdir/$program"; then
    # Add our own library path to LD_LIBRARY_PATH
    LD_LIBRARY_PATH=\$argdir/$ltdir
    export LD_LIBRARY_PATH

    # Run the actual program with our arguments.
    exec "\$argdir/$ltdir/$program" \${1+"\$\@"}

    echo "\$0: cannot exec $program \${1+"\$\@"}"
    exit 1
else
    echo "\$0: error: \\\`\$argdir/$ltdir/$program' does not exist." 1>&2
    exit 1
fi
EOF
;
}

sub is_prog_wrapper
{
	my $program = shift;

	open(my $pw, '<', $program) or die "cannot open $program: $!\n";
	return eval(grep { m/wrapper\sfor/ } <$pw>);
}

sub internal_resolve_la
{
	my ($level, $result, $rdeplibs, $args) = @_;
	Trace::debug {"resolve level: $level\n"};
	my $seen_pthread = 0;
	foreach my $a (@$args) {
		if ($a eq '-pthread') {
			$seen_pthread++;
			next;
		}
		push(@$result, $a);
		next if $a !~ m/\.la$/;
		my $lainfo = LaFile->parse($a);
		if (!exists $lainfo->{'cached_deplibs'}) {
		    $lainfo->{'cached_deplibs'} = [];
		    $lainfo->{'cached_result'} = [];
		    $lainfo->{'cached_pthread'} =
			internal_resolve_la($level+1, 
			    $lainfo->{'cached_result'}, 
			    $lainfo->{'cached_deplibs'}, 
			    $lainfo->deplib_list);
		    push(@{$lainfo->{'cached_deplibs'}}, 
			@{$lainfo->deplib_list});
		    if (@{$lainfo->{'cached_deplibs'}} > 50) {
		    	$lainfo->{'cached_deplibs'} = reverse_zap_duplicates_ref($lainfo->{'cached_deplibs'});
		    }
		    if (@{$lainfo->{'cached_result'}} > 50) {
		    	$lainfo->{'cached_result'} = reverse_zap_duplicates_ref($lainfo->{'cached_result'});
		    }
		}
		$seen_pthread += $lainfo->{'cached_pthread'};
		push(@$result, @{$lainfo->{'cached_result'}});
		push(@$rdeplibs, @{$lainfo->{'cached_deplibs'}});
	}
	$calls++;
	return $seen_pthread;
}

END
{
	Trace::print { "Calls to resolve_la: $calls\n" } if $calls;
}

# resolve .la files until a level with empty dependency_libs is reached.
sub resolve_la_list
{
	my $args = shift;
	my $result = [];
	if (internal_resolve_la(0, $result, \@deplibs, $args)) {
		unshift(@$result, '-pthread');
		unshift(@deplibs, '-pthread');
	}
	return $result;
}

# parse link flags and arguments
# eliminate all -L and -l flags in the argument string and add the
# corresponding directories and library names to the dirs/libs hashes.
# fill deplibs, to be taken up as dependencies in the resulting .la file...
# set up a hash for library files which haven't been found yet.
# deplibs are formed by collecting the original -L/-l flags, plus
# any .la files passed on the command line, EXCEPT when the .la file
# does not point to a shared library.
# pass 1 (la == 1)
# -Lfoo, -lfoo, foo.a, foo.la
# recursively find .la files corresponding to -l flags; if there is no .la
# file, just inspect the library file itself for any dependencies.
# pass 2 (la == 0)
# -Lfoo, -lfoo, foo.a
# no recursion in pass 2
# fill orderedlibs array, which is the sequence after resolving all .la

sub internal_parse_linkargs
{
	state $seen_pthread = 0;
	my ($result, $deplibs, $Rresolved, $libsearchdirs, $orderedlibs, 
	    $dirs, $libs, $libstofind, $args, 
	    $la, $level) = @_;
	Trace::debug {"parse_linkargs pass: ", ($la == 1) ? 1 : 2, ", level: $level\n"};
	Trace::debug {"  args: @$args\n"};

	foreach my $a (@$args) {
		Trace::debug {"  processing $a\n"};
		if ($a eq '-lc') {	
			# don't link explicitly with libc (just remove -lc)
		} elsif ($a eq '-pthread' && !$seen_pthread) {	
			# XXX special treatment since it's not a -l flag
			push @$deplibs, $a;
			$seen_pthread = 1;
			push(@$result, $a);
		} elsif ($a && $a =~ m/^-L(.*)/) {
			if (!exists $dirs->{$1}) {
				$dirs->{$1} = 1;
				push @$deplibs, $a;
			}
		} elsif ($a && $a =~ m/^-R(.*)/) {
			# -R options originating from .la resolution
			# those from @ARGV are in @Ropts
			push @$Rresolved, $1;
		} elsif ($a && $a =~ m/^-l(.*)/) {
			my @largs = ();
			my $key = $1;
			if (!exists $libstofind->{$key}) {
				$libstofind->{$key} = 1;
				if ($la) {
					my $lafile = find_la($key);
					if ($lafile) {
						push @$deplibs, $lafile;
						push(@$result, $lafile);
						next;
					} else {
						my $libpath = find_lib($key, @$libsearchdirs);
						if (!$libpath) {
							die "library $key could not be found.\n";
						}
						# avoid searching again later
						$libs->{$key} = $libpath;
						my @deps = inspect_lib($libpath);
						# push @$rdeplibs, @deps;
						foreach my $d (@deps) {
							my $k = basename $d;
							$k =~ s/^(\S+)\.so.*$/$1/;
							$k =~ s/^lib//;
							push(@largs, "-l$k");
						}
						push @$deplibs, $a;
					}
				}
			}
			if ($la) {
				push(@$result, $a);
				internal_parse_linkargs($result, $deplibs, 
				    $Rresolved, $libsearchdirs, $orderedlibs, 
				    $dirs, $libs, $libstofind, \@largs, $la, 
				    $level+1) if @largs;
			} else {
				push @$orderedlibs, $key;
			}
		} elsif ($a && $a =~ m/(\S+\/)*(\S+)\.a$/) {
			my $key = $2;
			$key =~ s/^lib//;
			$libs->{$key} = $a;
			if ($la) {
				push(@$result, $a);
			} else {
				push @$orderedlibs, $key;
			}
		} elsif ($a && $a =~ m/(\S+\/)*(\S+)\.la$/) {
			my $key = $2;
			$key =~ s/^lib//;
			my $d = abs_path(dirname($a));
			$dirs->{$d} = 1;
			my $fulla = abs_path($a);
			my $lainfo = LaFile->parse($fulla);
			my $dlname = $lainfo->{'dlname'};
			my $oldlib = $lainfo->{'old_library'};
			my $libdir = $lainfo->{'libdir'};
			if ($d !~ m/\Q$ltdir\E$/ && $lainfo->{'installed'} eq 'no') {
				$d .= "/$ltdir";
			}
			if ($libdir ne '' && $la) {
				push @$deplibs, $fulla;
			}
			# the following should happen only in pass 2
			if ($la) {
				push(@$result, $a);
				next;
			}
			push @$orderedlibs, $key;
			# get the name we need (this may include a -release)
			if (!$dlname && !$oldlib) {
				die "neither static nor shared library found in $a\n";
			}
			# XXX in some cases there are multiple libs with the same name
			# so probably need to use a different key
			if ($dlname eq '') {
				# static
				$libs->{$key} = "$d/$oldlib";
			} else {
				# shared
				$libs->{$key} = "$d/$dlname";
			}
			Trace::debug {"\$libs{$key} = ", $libs->{$key}, "\n"};
		} else {
			push(@$result, $a);
		}
	}
	Trace::debug {"end parse_linkargs\n"};
}

sub parse_linkargs_list
{
	my ($args, $la) = @_;

	my $result = [];
	internal_parse_linkargs($result, \@deplibs, \@Rresolved, \@libsearchdirs, \@orderedlibs, \%dirs, \%libs,
	    \%libstofind, $args, $la, 0);
	return $result;
}

# find .la file associated with a -llib flag
# XXX pick the right one if multiple are found!
sub find_la
{
	my $l = shift;

	# sort dir search order by priority
	# XXX not fully correct yet
	my @dirs = sort { $dirs{$b} <=> $dirs{$a} } keys %dirs;
	Trace::debug {"searching .la for $l\n"};
	Trace::debug {"search path= ", join(':', @dirs), "\n"};
	foreach my $d (@dirs) {
		foreach my $la_candidate ("$d/lib$l.la", "$d/$l.a") {
			if (-f $la_candidate) {
				Trace::debug {"found $la_candidate\n"};
				return $la_candidate;
			}
		}
	}
	Trace::debug {".la for $l not found!\n"};
	return 0;
}

# find actual library filename
# XXX pick the right one if multiple are found!
sub find_lib
{
	my $libtofind = shift;
	my @ldconfigdirs = @_;	# search there last

	my $libfile = 0;
	my @globbedlib;

	# sort dir search order by priority
	# XXX not fully correct yet
	my @dirs = sort { $dirs{$b} <=> $dirs{$a} } keys %dirs;
	# search in .libs when priority is high
	map { $_ = "$_/$ltdir" if (exists $dirs{$_} && $dirs{$_} > 3) } @dirs;
	push @dirs, @ldconfigdirs;
	Trace::debug {"searching for $libtofind\n"};
	Trace::debug {"search path= ", join(':', @dirs), "\n"};
	foreach my $sd (@dirs) {
		# select correct library by sorting by version number only
		@globbedlib = sort { my ($x,$y) =
			map { /\.so\.(\d+\.\d+)$/; $1 } ($a,$b); $y <=> $x }
			glob "$sd/lib$libtofind.so.*.*";
		if ($globbedlib[0]) {
			Trace::debug {"found $libtofind in $sd\n"};
			$libfile = $globbedlib[0];
			last;
		} else {	# XXX find static library instead?
			if (-f "$sd/lib$libtofind.a") {
				Trace::debug {"found static $libtofind in $sd\n"};
				$libfile = "$sd/lib$libtofind.a";
				last;
			}
		}
	}
	say "$libtofind not found!" if !$libfile;
	return $libfile;
}

# give a list of library dependencies found in the actual shared library
sub inspect_lib
{
	my $filename = shift;

	my @deps;
	Trace::debug {"inspecting $filename for library dependencies...\n"};
	open(my $fh, '-|', "objdump -p $filename");
	while (<$fh>) {
		if (m/\s+NEEDED\s+(\S+)\s*$/) {
			push @deps, $1;
		}
	}
	Trace::debug {"found ", (@deps == 0) ? 'no ' : '',
		"deps for $filename\n@deps\n"};
	return @deps;
}

# prepare dependency_libs information for the .la file which is installed
# i.e. remove any .libs directories and use the final libdir for all the
# .la files
sub process_deplibs
{
	my $linkflags = shift;

	my $result;

	foreach my $lf (@$linkflags) {
		if ($lf =~ m/-L\S+\Q$ltdir\E$/) {
		} elsif ($lf =~ m/\/\S+\/(\S+\.la)/) {
			my $lafile = $1;
			$lf = LaFile->parse($lf)->{'libdir'}.'/'.$lafile;
			push @$result, $lf;
		} else {
			push @$result, $lf;
		}
	}
	return $result;
}

# construct linker command (list) for either libraries or programs
sub linkcmds
{
	my $la = shift;
	my $fname = shift;
	my $odir = shift;
	my $lmode = shift;	# LIBRARY or PROGRAM
	my $shared = shift;
	my $objs = shift;

	Trace::debug {"creating link command for ",
		($lmode == PROGRAM) ? "program" : "library", " (linked ",
		($shared) ? "dynam" : "stat", "ically)\n"};
	
	my @libflags;
	my @cmdlist;
	my $cmd = '';
	my $dst = ($odir eq '.') ? "$ltdir/$fname" : "$odir/$ltdir/$fname";
	mkdir "$odir/$ltdir" if (! -d "$odir/$ltdir");

	Trace::debug {"argvstring (pre resolve_la): @ARGV\n"};
	my $argv = resolve_la_list(\@ARGV);
	Trace::debug {"argvstring (post resolve_la): @$argv\n"};
	@orderedlibs = ();
	$argv = parse_linkargs_list($argv, 0);
	Trace::debug {"deplibs = @deplibs\n"};
	Trace::debug {"orderedlibs = @orderedlibs\n"};
	my @finalorderedlibs = reverse_zap_duplicates(@orderedlibs);
	Trace::debug {"final orderedlibs = @finalorderedlibs\n"};
	# static linking
	if (!$shared) {
		Trace::debug {"dirs:\n", join("\n", (keys %dirs)), "\n"};
		Trace::debug {"libs:\n", join("\n", (keys %libs)), "\n"};
		Trace::debug {"libfiles:\n", join("\n", (values %libs)), "\n"};
		if ($lmode == LIBRARY) {
			$cmd = "ar cru $dst";
			$cmd .= " @$objs" if (@$objs);
			foreach my $k (@finalorderedlibs) {
				unless (defined $libs{$k}) {
					Trace::debug {"library $k not found in \%libs\n"};
					next;
				}
				my $a = $libs{$k};
				if ($a =~ m/\.a$/ && $a !~ m/_pic\.a/) {
					# extract objects from archive
					my $libfile = basename $a;
					my $xdir = "$odir/$ltdir/${la}x/$libfile";
					extract_archive($xdir, $a);
					my @kobjs = get_objlist_from_archive($a);
					map { $_ = "$xdir/$_"; } @kobjs;
					push @libflags, @kobjs;
				}
			}
			$cmd .= " @libflags" if (@libflags);
			push @cmdlist, $cmd;
			push @cmdlist, "ranlib $dst";
			return @cmdlist;
		} elsif ($lmode == PROGRAM) {
			die "static linking of programs not supported yet\n";
		}
	}

	# dynamic linking
	my @RPdirs = ();
	my $symbolsfile;
	if ($opts{'export-symbols'}) {
		$symbolsfile = $opts{'export-symbols'};
	} elsif ($opts{'export-symbols-regex'}) {
		$symbolsfile = "$odir/$ltdir/$la";
		$symbolsfile =~ s/\.la$/.exp/;
		get_symbollist($symbolsfile, $opts{'export-symbols-regex'}, $objs);
	}
	if ($lmode == PROGRAM) {
		@RPdirs = (@Ropts, @RPopts, @Rresolved);
		@RPdirs = reverse_zap_duplicates(@RPdirs);
		map { $_ = "-Wl,-rpath,$_" } @RPdirs;
	}
	foreach my $l (keys %libstofind) {
		my $libpath = find_lib($l);
		$libs{$l} = $libpath if ($libpath);
	}

	my @libfiles = values %libs;
	Trace::debug {"dirs:\n", join("\n", (keys %dirs)), "\n"};
	Trace::debug {"libs:\n", join("\n", (keys %libs)), "\n"};
	Trace::debug {"libfiles:\n", join("\n", @libfiles), "\n"};

	create_symlinks($ltdir, \@libfiles);
	map { $_ = "$ltdir/". basename $_ } @libfiles;
	Trace::debug {"symlinks to libfiles used for linking:\n", join("\n", @libfiles), "\n"};
	my $prev_was_archive = 0;
	my $libcounter = 0;
	foreach my $k (@finalorderedlibs) {
		my $a = $libs{$k} || die "ERROR: $k not found in \$libs";
		if ($a =~ m/\.a$/) {
			# don't make a -lfoo out of a static library
			if ($lmode == LIBRARY) {
				if (!$prev_was_archive) {
					push @libflags, '-Wl,-whole-archive';
				}
			}
			push @libflags, $a;
			if ($lmode == LIBRARY) {
				if ($libcounter == @finalorderedlibs - 1) {
					push @libflags, '-Wl,-no-whole-archive';
				}
			}
			$prev_was_archive = 1;
		} else {
			if ($lmode == LIBRARY) {
				if ($prev_was_archive) {
					push @libflags, '-Wl,-no-whole-archive';
				}
			}
			$prev_was_archive = 0;
			my $lib = basename $a;
			if ($lib =~ m/^lib(.*)\.so(\.\d+){2}/) {
				$lib = $1;
			} else {
				say "warning: cannot derive -l flag from library filename, assuming hash key";
				$lib = $k;
			}
			push @libflags, "-l$lib";
		}
		$libcounter++;
	}

	$cmd = "$ltprog";
	$cmd .= " $sharedflag $picflags" if ($lmode == LIBRARY);
	$cmd .= " -o $dst";
	$cmd .= " @$argv";
	$cmd .= " @$objs" if (@$objs);
	$cmd .= " -L$ltdir @libflags" if (@libflags);
	$cmd .= " @RPdirs" if (@RPdirs);
	$cmd .= " -Wl,-retain-symbols-file,$symbolsfile" if ($symbolsfile);
	push @cmdlist, $cmd;

	return @cmdlist;
}

# populate arrays of non-pic and pic objects and remove these from @ARGV
sub generate_objlist
{
	my $objs = shift;
	my $sobjs = shift;
	my $objsource = shift;
	my $allpic = 1;

	foreach my $a (@$objsource) {
		if ($a =~ m/\S+\.lo$/) {
			my $ofile = basename $a;
			my $odir = dirname $a;
			my $loinfo = LoFile->parse($a);
			if ($loinfo->{'non_pic_object'}) {
				my $o;
				$o .= "$odir/" if ($odir ne '.');
				$o .= $loinfo->{'non_pic_object'};
				push @$objs, $o;
			}
			if ($loinfo->{'pic_object'}) {
				my $o;
				$o .= "$odir/" if ($odir ne '.');
				$o .= $loinfo->{'pic_object'};
				push @$sobjs, $o;
			} else {
				$allpic = 0;
			}
			$a = '';
		}
	}
	return $allpic;
}

# XXX reuse code from SharedLibs.pm instead
sub get_search_dirs
{
	my @libsearchdirs;
	open(my $fh, '-|', 'ldconfig -r');
	if (defined $fh) {
		while (<$fh>) {
			if (m/^\s*search directories:\s*(.*?)\s*$/o) {
				foreach my $d (split(/\:/o, $1)) {
					push @libsearchdirs, $d;
				}
				last;
			}
		}
		close($fh);
	} else {
		die "Can't find ldconfig\n";
        }
	return @libsearchdirs;
}

sub extract_archive
{
	my $dir = shift;
	my $archive = shift;

	if (! -d $dir) {
		Trace::debug {"mkdir -p $dir\n"};
		File::Path::mkpath($dir);
	}
	Exec->chdir($dir)->command('ar', 'x', $archive);
}

sub get_objlist_from_archive
{
	my $a = shift;

	open(my $arh, '-|', "ar t $a");
	my @o = <$arh>;
	close $arh;
	map { chomp; } @o;
	return @o;
}

sub get_symbollist
{
	my $filepath = shift;
	my $regex = shift;
	my $objlist = shift;

	Trace::debug {"generating symbol list in file: $filepath\n"};
	my @symbols;
	open(my $sh, '-|', 'nm', @$objlist) or die "error running nm on object list\n";
	my $c = 0;
	while (my $line = <$sh>) {
		chomp $line;
		Trace::debug {"$c: $line\n"};
		if ($line =~ m/\S+\s+[BCDEGRST]\s+(.*)/) {
			my $s = $1;
			if ($s =~ m/$regex/) {
				push @symbols, $s;
				Trace::debug {"matched\n"};
			}
		}
		$c++;
	}
	@symbols = reverse_zap_duplicates(@symbols);
	@symbols = sort @symbols;
	open(my $fh, '>', $filepath) or die "cannot open $filepath\n";
	print $fh join("\n", @symbols), "\n";
}

# walk a list from back to front, removing any duplicates
# this should make sure a library's dependencies are behind the library itself
sub reverse_zap_duplicates
{
	my @arglist = @_;

	my $h = {};
	my @r;
	for (my $i = $#arglist; $i >= 0; $i--) {
		my $el = $arglist[$i];
		next if (defined $h->{$el});
		unshift @r, $el;
		$h->{$el} = 1;
	}
	return @r;
}

sub reverse_zap_duplicates_ref
{
	my $arglist = shift;
	my $h = {};
	my $r = [];
	for my $el (reverse @$arglist) {
		next if defined $h->{$el};
		unshift @$r, $el;
		$h->{$el} = 1;
	}
	return $r;
}

# try to guess libtool mode when it is not specified
sub guess_implicit_mode
{
	my $m = 0;
	if ($ltprog =~ m/(install([.-]sh)?|cp)$/) {
		$m = 'install';
	} elsif ($ltprog =~ m/cc|c\+\+/) {	# XXX improve test
		if (grep { $_ eq '-c' } @ARGV) {
			$m = 'compile';
		} else {
			$m = 'link';
		}
	}
	return $m;	
}

# escape quotes and meta-characters
# protect elements containing whitespace or meta-characters by quotes
sub handle_special_chars
{
	my $a = shift;
	map { $_ =~ s,(['"]),\\$1,g; $_ = "\"$_\"" if $_ =~ m/[\s&()<>]/ } @$a;
}