#!/usr/bin/perl
# $OpenBSD: libtool,v 1.8 2012/07/01 17:22:28 espie Exp $

# Copyright (c) 2007-2010 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 LT::Trace;
use LT::Exec;
use LT::Util;


package main;
$SIG{__DIE__} = sub {
	require Carp;

	my $_ = pop @_;
	s/(.*)( at .*? line .*?\n$)/$1/s;
	push @_, $_;
	die &Carp::longmess;
};


use subs qw(
	create_symlinks
	guess_implicit_mode
	help
	notyet
	);



use Config;
my @no_shared_archs = qw(m88k vax);
my $machine_arch = $Config{'ARCH'};
(my $gnu_arch = $machine_arch) =~ s/amd64/x86_64/;
my @valid_modes = qw(clean compile execute finish install link uninstall);
my $cwd = getcwd();
my $instlibdir = '/usr/local/lib';
$instlibdir = $ENV{'LIBDIR'} if defined $ENV{'LIBDIR'};

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

my %opts;		# options passed to libtool
my @tags;		# list of --tag options passed to libtool

# 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 $noshared = 0;
if (grep { $_ eq $machine_arch } @no_shared_archs) {
	$noshared = 1;
}

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 { LT::Exec->dry_run },
		'features' => \&notyet,
		'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 "libtool (not (GNU libtool)) $version" ; exit(0); },
	);

if ($verbose || $D) {
	LT::Exec->verbose_run;
}
# what are we going to run (cc, c++, ...)
my $ltprog = [];
# deal with multi-arg ltprog
LT::Trace::debug {"ARGV = @ARGV\n"};
while (@ARGV) {
	# just read arguments until the next option...
	if ($ARGV[0] =~ m/^\-/) { last; }
	# XXX improve checks
	if ($ARGV[0] =~ m/^\S+\.la/) { last; }
	my $arg = shift @ARGV;
	push @$ltprog, $arg;
	LT::Trace::debug {"arg = \"$arg\"\n"};
	# if the current argument is an install program, stop immediately
	if ($arg =~ /cp$/) { last; }
	if ($arg =~ /install([-.]sh)?$/) { last; }
}
LT::Trace::debug {"ltprog = \"@$ltprog\"\n"};
if (@$ltprog == 0) { die "No libtool command given.\n" .
			 "Use `libtool --help' for more information.\n" };
# make ltprog a list of elements without whitespace (prevent exec errors)
my @tmp_ltprog = @$ltprog;
@$ltprog = ();
for my $el (@tmp_ltprog) {
	my @parts = split /\s+/, $el;
	push @$ltprog, @parts;
}

# check mode and guess it if needed
if (!($mode && grep { $_ eq $mode } @valid_modes)) {
	$mode = guess_implicit_mode($ltprog);
	if ($mode) {
		LT::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');

if ($mode eq 'compile') {
	require LT::Mode::Compile;
	LT::Mode::Compile->run($ltprog, $gp, \@tags, $noshared);
} elsif ($mode eq 'install') {
	require LT::Mode::Install;
	LT::Mode::Install->run($ltprog);

} elsif ($mode eq 'link') {
	require LT::Mode::Link;
	LT::Mode::Link->run($ltprog, $gp, \@tags, $noshared);
} 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
	LT::Exec->silent_run;
	LT::Exec->execute(@$ltprog, @ARGV);
} else {
	die "MODE=$mode not implemented yet.\n";
}

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

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

sub help
{
	print <<EOF
Usage: $0 [options]
--config - print configuration
--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=TAG - specify a configuration variable TAG
--version - print version of libtool
EOF
;
	exit 1;
}

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

# XXX incomplete
sub config
{
	print "objdir=$ltdir\n";
	print "arch=$machine_arch\n";
	print "...\n";
	exit 0;
}

sub create_symlinks
{
	my ($dir, $libs) = @_;
	if (! -d $dir) {
		mkdir($dir) or die "Cannot mkdir($dir) : $!\n";
	}

	foreach my $l (values %$libs) {
		my $f = $l->{fullpath};
		next if !defined $f;
		next if $f =~ m/\.a$/;
		my $libnames = [];
		if (defined $l->{lafile}) {
			require LT::LaFile;
			my $lainfo = LT::LaFile->parse($l->{lafile});
			my $librarynames = $lainfo->stringize('library_names');
			@$libnames = split /\s/, $librarynames;
			$libnames = reverse_zap_duplicates_ref($libnames);
		} else {
			push @$libnames, basename($f);
		}	
		foreach my $libfile (@$libnames) {
			my $link = "$dir/$libfile";
			LT::Trace::debug {"ln -s $f $link\n"};
			next if -f $link;
			my $p = abs_path($f);
			if (!symlink($p, $link)) {
				die "Cannot create symlink($p, $link): $!\n"
				    unless  $!{EEXIST}
			}
		}
	}
	return $dir;
}

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