File: [local] / src / usr.bin / libtool / libtool (download)
Revision 1.13, Fri Jul 6 11:30:40 2012 UTC (11 years, 11 months ago) by espie
Branch: MAIN
Changes since 1.12: +2 -1 lines
add my copyright, since I'm going to do yet MORE changes...
|
#!/usr/bin/perl
# $OpenBSD: libtool,v 1.13 2012/07/06 11:30:40 espie Exp $
# Copyright (c) 2007-2010 Steven Mestdagh <steven@openbsd.org>
# Copyright (c) 2012 Marc Espie <espie@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 LT::Trace;
use LT::Exec;
use LT::Util;
$SIG{__DIE__} = sub {
require Carp;
my $_ = pop @_;
s/(.*)( at .*? line .*?\n$)/$1/s;
push @_, $_;
die &Carp::longmess;
};
package LT::Options;
use Getopt::Long;
my @valid_modes = qw(compile clean execute finish install link uninstall);
my @known_tags = qw(disable-shared disable-static CC CXX F77 FC GO GCJ RC);
sub new
{
my $class = shift;
my $o = bless { gp => Getopt::Long::Parser->new }, $class;
# require_order so we stop parsing at the first non-option or argument,
# instead of parsing the whole ARGV.
$o->{gp}->configure('no_ignore_case',
'pass_through',
'no_auto_abbrev',
'require_order');
return $o;
}
sub add_tag
{
my ($self, $value) = @_;
if ($value =~ m/[^\-\w,\/]/) {
# XXX stupid Getopt pre-empts die !
say STDERR "invalid tag name: $value";
exit 1;
}
if (grep {$value eq $_} @known_tags) {
$self->{tags}{$value} = 1;
} else {
say STDERR "ignoring unknown tag: $value";
}
}
sub has_tag
{
my ($self, $tag) = @_;
return defined $self->{tags}{$tag};
}
sub configure
{
my $o = shift;
$o->{gp}->configure(@_);
}
sub getoptions
{
my $o = shift;
$o->{gp}->getoptions(@_);
}
sub is_abreviated_mode
{
my ($self, $arg) = @_;
for my $m (@valid_modes) {
next if length $arg > length $m;
if ($arg eq substr($m, 0, length $arg)) {
return $m;
}
}
return undef;
}
sub is_valid_mode
{
my ($self, $mode) = @_;
if (defined $mode) {
return grep {$_ eq $mode} @valid_modes;
} else {
return 0;
}
}
# XXX this should always fail if we are libtool2 !
# try to guess libtool mode when it is not specified
sub guess_implicit_mode
{
my ($self, $ltprog) = @_;
my $m;
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;
}
sub valid_modes
{
my $self = shift;
return join(' ', @valid_modes);
}
package main;
use subs qw(
create_symlinks
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 $cwd = getcwd();
my $instlibdir = '/usr/local/lib';
$instlibdir = $ENV{'LIBDIR'} if defined $ENV{'LIBDIR'};
my $mode;
my $verbose = 1;
# 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;
}
if ($mode = LT::Options->is_abreviated_mode($ARGV[0])) {
shift @ARGV;
}
my $gp = LT::Options->new;
$gp->getoptions('config' => \&config,
'debug' => sub {
LT::Trace->set($_[1]);
LT::Exec->verbose_run;
},
'dry-run|n' => sub { LT::Exec->dry_run; },
'features' => sub {
my $v = `uname -r`;
chomp $v;
say "host: $gnu_arch-unknown-openbsd$v";
say "enable shared libraries" unless $noshared;
say "enable static libraries";
exit 0;
},
'finish' => sub { $mode = 'finish'; },
'help' => \&help, # does not return
'mode=s{1}' => \$mode,
'quiet' => sub { $verbose = 0; },
'silent' => sub { $verbose = 0; },
'tag=s{1}' => sub { $gp->add_tag($_[1]); },
'version' => sub {
say "libtool (not (GNU libtool)) $version" ;
exit 0;
},
);
if ($verbose) {
LT::Exec->verbose_run;
}
# what are we going to run (cc, c++, ...)
my $ltprog = [];
# deal with multi-arg ltprog
tsay {"ARGV = \"@ARGV\""};
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;
tsay {"arg = \"$arg\""};
# if the current argument is an install program, stop immediately
if ($arg =~ /cp$/) { last; }
if ($arg =~ /install([-.]sh)?$/) { last; }
}
tsay {"ltprog = \"@$ltprog\""};
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;
}
if (!defined $mode) {
$mode = $gp->guess_implicit_mode($ltprog);
tsay {"implicit mode: ", $mode} if $mode;
}
if (!$gp->is_valid_mode($mode)) {
say STDERR "$0: $mode: invalid argument for --mode" if defined $mode;
die "MODE must be one of: ", $gp->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, $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, $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";
tsay {"ln -s $f $link"};
next if -f $link;
my $p = abs_path($f);
if (!symlink($p, $link)) {
die "Cannot create symlink($p, $link): $!\n"
unless $!{EEXIST};
}
}
}
return $dir;
}