Annotation of src/usr.bin/libtool/libtool, Revision 1.19
1.1 espie 1: #!/usr/bin/perl
1.19 ! espie 2: # $OpenBSD: libtool,v 1.18 2012/07/07 21:09:27 jasper Exp $
1.1 espie 3:
4: # Copyright (c) 2007-2010 Steven Mestdagh <steven@openbsd.org>
1.13 espie 5: # Copyright (c) 2012 Marc Espie <espie@openbsd.org>
1.1 espie 6: #
7: # Permission to use, copy, modify, and distribute this software for any
8: # purpose with or without fee is hereby granted, provided that the above
9: # copyright notice and this permission notice appear in all copies.
10: #
11: # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
12: # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
13: # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
14: # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
15: # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
16: # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
17: # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
18:
19: use strict;
20: use warnings;
21: use feature qw(say switch state);
22: use Cwd qw(getcwd abs_path);
23: use File::Basename;
24: use File::Glob ':glob';
25: use File::Path;
1.3 espie 26:
1.1 espie 27: use LT::Trace;
28: use LT::Exec;
29: use LT::Util;
30:
1.3 espie 31: $SIG{__DIE__} = sub {
32: require Carp;
33:
34: my $_ = pop @_;
35: s/(.*)( at .*? line .*?\n$)/$1/s;
36: push @_, $_;
37: die &Carp::longmess;
38: };
39:
1.16 jasper 40: package LT::OSConfig;
41:
42: use Config;
1.18 jasper 43: use LT::Util;
1.16 jasper 44:
45: sub new
46: {
47: my $class = shift;
1.18 jasper 48: # XXX: incomplete
49: my $self = {
1.19 ! espie 50: machine_arch => $Config{ARCH},
1.18 jasper 51: ltdir => $ltdir,
52: };
1.19 ! espie 53: ($self->{gnu_arch} = $self->{machine_arch}) =~ s/amd64/x86_64/;
1.18 jasper 54: bless $self, $class;
1.16 jasper 55: }
56:
1.19 ! espie 57: package LT::Mode;
! 58:
! 59: sub new
! 60: {
! 61: my ($class, $origin) = @_;
! 62: # XXX autoload *if needed*.
! 63: eval "require $class; ";
! 64: bless {origin => $origin }, $class;
! 65: }
! 66:
! 67: my $mode_maker = { compile => 'LT::Mode::Compile',
! 68: clean => 'LT::Mode::Clean',
! 69: execute => 'LT::Mode::Execute',
! 70: finish => 'LT::Mode::Finish',
! 71: install => 'LT::Mode::Install',
! 72: link => 'LT::Mode::Link',
! 73: uninstall => 'LT::Mode::Uninstall' };
! 74:
! 75: sub factory
! 76: {
! 77: my ($class, $mode, $origin) = @_;
! 78: if (defined $mode_maker->{$mode}) {
! 79: return $mode_maker->{$mode}->new($origin);
! 80: } else {
! 81: # XXX invokved from getopt, can't die yet.
! 82: say STDERR "Mode=$mode not implemented yet.\n";
! 83: exit 1;
! 84: }
! 85: }
! 86:
! 87: package LT::Mode::Empty;
! 88: our @ISA = qw(LT::Mode);
! 89: sub run
! 90: {
! 91: exit 0;
! 92: }
! 93: package LT::Mode::Compile;
! 94: our @ISA = qw(LT::Mode);
! 95:
! 96: package LT::Mode::Clean;
! 97: our @ISA = qw(LT::Mode::Empty);
! 98:
! 99: package LT::Mode::Execute;
! 100: our @ISA = qw(LT::Mode);
! 101: sub run
! 102: {
! 103: my ($class, $ltprog, $gp, $noshared) = @_;
! 104: # XXX check whether this is right
! 105: LT::Exec->silent_run;
! 106: LT::Exec->execute(@$ltprog, @main::ARGV);
! 107: }
! 108:
! 109: package LT::Mode::Finish;
! 110: our @ISA = qw(LT::Mode::Empty);
! 111:
! 112: package LT::Mode::Install;
! 113: our @ISA = qw(LT::Mode);
! 114:
! 115: package LT::Mode::Link;
! 116: our @ISA = qw(LT::Mode);
! 117:
! 118: package LT::Mode::Uninstall;
! 119: our @ISA = qw(LT::Mode::Empty);
! 120:
1.10 espie 121: package LT::Options;
122: use Getopt::Long;
123:
124: my @valid_modes = qw(compile clean execute finish install link uninstall);
1.19 ! espie 125:
1.10 espie 126: my @known_tags = qw(disable-shared disable-static CC CXX F77 FC GO GCJ RC);
127:
128: sub new
129: {
130: my $class = shift;
131: my $o = bless { gp => Getopt::Long::Parser->new }, $class;
132: # require_order so we stop parsing at the first non-option or argument,
133: # instead of parsing the whole ARGV.
134: $o->{gp}->configure('no_ignore_case',
135: 'pass_through',
136: 'no_auto_abbrev',
137: 'require_order');
138: return $o;
139: }
140:
141: sub add_tag
142: {
143: my ($self, $value) = @_;
144: if ($value =~ m/[^\-\w,\/]/) {
145: # XXX stupid Getopt pre-empts die !
146: say STDERR "invalid tag name: $value";
147: exit 1;
148: }
149: if (grep {$value eq $_} @known_tags) {
150: $self->{tags}{$value} = 1;
151: } else {
152: say STDERR "ignoring unknown tag: $value";
153: }
154: }
155:
156: sub has_tag
157: {
158: my ($self, $tag) = @_;
159: return defined $self->{tags}{$tag};
160: }
161:
162: sub configure
163: {
164: my $o = shift;
165: $o->{gp}->configure(@_);
166: }
167:
168: sub getoptions
169: {
170: my $o = shift;
171: $o->{gp}->getoptions(@_);
172: }
173:
174: sub is_abreviated_mode
175: {
176: my ($self, $arg) = @_;
1.15 jasper 177: return undef if !$arg;
1.10 espie 178: for my $m (@valid_modes) {
179: next if length $arg > length $m;
180: if ($arg eq substr($m, 0, length $arg)) {
1.19 ! espie 181: return LT::Mode->factory($m, $arg);
1.10 espie 182: }
183: }
184: return undef;
185: }
186:
187: # XXX this should always fail if we are libtool2 !
188: # try to guess libtool mode when it is not specified
189: sub guess_implicit_mode
190: {
191: my ($self, $ltprog) = @_;
192: my $m;
193: for my $a (@$ltprog) {
194: if ($a =~ m/(install([.-]sh)?|cp)$/) {
1.19 ! espie 195: $m = LT::Mode::Install->new("implicit $a");
1.10 espie 196: } elsif ($a =~ m/cc|c\+\+/) { # XXX improve test
197: if (grep { $_ eq '-c' } @ARGV) {
1.19 ! espie 198: $m = LT::Mode::Compile->new("implicit");
1.10 espie 199: } else {
1.19 ! espie 200: $m = LT::Mode::Link->new("implicit");
1.10 espie 201: }
202: }
203: }
204: return $m;
205: }
206:
207: sub valid_modes
208: {
209: my $self = shift;
210: return join(' ', @valid_modes);
211: }
212:
213: package main;
1.1 espie 214:
215: use subs qw(
216: create_symlinks
217: help
218: notyet
219: );
220:
1.17 espie 221: my $ltconfig = LT::OSConfig->new;
1.1 espie 222: my @no_shared_archs = qw(m88k vax);
223: my $cwd = getcwd();
1.19 ! espie 224: my $instlibdir = $ENV{LIBDIR} // '/usr/local/lib';
1.1 espie 225:
226: my $mode;
227: my $verbose = 1;
228:
229: # just to be clear:
230: # when building a library:
231: # * -R libdir records libdir in dependency_libs
232: # * -rpath is the path where the (shared) library will be installed
233: # when building a program:
234: # * both -R libdir and -rpath libdir add libdir to the run-time path
235: # -Wl,-rpath,libdir will bypass libtool.
236:
237: # build static/shared objects?
238: my $noshared = 0;
1.19 ! espie 239: if (grep { $_ eq $ltconfig->{machine_arch} } @no_shared_archs) {
1.1 espie 240: $noshared = 1;
241: }
242:
1.10 espie 243:
244: if ($mode = LT::Options->is_abreviated_mode($ARGV[0])) {
245: shift @ARGV;
246: }
247:
248: my $gp = LT::Options->new;
1.1 espie 249: $gp->getoptions('config' => \&config,
1.10 espie 250: 'debug' => sub {
251: LT::Trace->set($_[1]);
252: LT::Exec->verbose_run;
253: },
254: 'dry-run|n' => sub { LT::Exec->dry_run; },
255: 'features' => sub {
256: my $v = `uname -r`;
257: chomp $v;
1.18 jasper 258: say "host: $ltconfig->{gnu_arch}-unknown-openbsd$v";
1.10 espie 259: say "enable shared libraries" unless $noshared;
260: say "enable static libraries";
261: exit 0;
262: },
1.19 ! espie 263: 'finish' => sub { $mode = LT::Mode::Finish->new('--finish'); },
1.1 espie 264: 'help' => \&help, # does not return
1.19 ! espie 265: 'mode=s{1}' => sub {
! 266: $mode = LT::Mode->factory($_[1], "--mode=$_[1]");
! 267: },
1.1 espie 268: 'quiet' => sub { $verbose = 0; },
269: 'silent' => sub { $verbose = 0; },
1.10 espie 270: 'tag=s{1}' => sub { $gp->add_tag($_[1]); },
271: 'version' => sub {
272: say "libtool (not (GNU libtool)) $version" ;
273: exit 0;
274: },
1.1 espie 275: );
276:
1.10 espie 277: if ($verbose) {
1.1 espie 278: LT::Exec->verbose_run;
279: }
1.10 espie 280:
1.1 espie 281: # what are we going to run (cc, c++, ...)
282: my $ltprog = [];
283: # deal with multi-arg ltprog
1.10 espie 284: tsay {"ARGV = \"@ARGV\""};
1.1 espie 285: while (@ARGV) {
286: # just read arguments until the next option...
287: if ($ARGV[0] =~ m/^\-/) { last; }
288: # XXX improve checks
289: if ($ARGV[0] =~ m/^\S+\.la/) { last; }
290: my $arg = shift @ARGV;
291: push @$ltprog, $arg;
1.10 espie 292: tsay {"arg = \"$arg\""};
1.1 espie 293: # if the current argument is an install program, stop immediately
294: if ($arg =~ /cp$/) { last; }
295: if ($arg =~ /install([-.]sh)?$/) { last; }
296: }
1.10 espie 297: tsay {"ltprog = \"@$ltprog\""};
1.14 espie 298:
299: # XXX compat game to satisfy both libtool 1 and libtool 2
300: # let libtool install work as both libtool 1 and libtool 2
1.19 ! espie 301: if (@$ltprog == 0 && defined $mode && $mode->{origin} eq 'install') {
! 302: $ltprog = [ 'install' ];
1.14 espie 303: }
1.6 jasper 304: if (@$ltprog == 0) { die "No libtool command given.\n" .
305: "Use `libtool --help' for more information.\n" };
1.1 espie 306: # make ltprog a list of elements without whitespace (prevent exec errors)
307: my @tmp_ltprog = @$ltprog;
308: @$ltprog = ();
309: for my $el (@tmp_ltprog) {
310: my @parts = split /\s+/, $el;
311: push @$ltprog, @parts;
312: }
313:
1.10 espie 314: if (!defined $mode) {
315: $mode = $gp->guess_implicit_mode($ltprog);
1.19 ! espie 316: tsay {"implicit mode: ", $mode->{origin}} if $mode;
1.1 espie 317: }
318:
319: # from here, options may be intermixed with arguments
320: $gp->configure('permute');
321:
1.19 ! espie 322: $mode->run($ltprog, $gp, $noshared);
1.1 espie 323:
324: if (LT::Exec->performed == 0) {
325: die "No commands to execute.\n"
326: }
327:
328: ###########################################################################
329:
330: sub help
331: {
332: print <<EOF
333: Usage: $0 [options]
334: --config - print configuration
335: --debug - turn on debugging output
336: --dry-run - don't do anything, only show what would be done
337: --help - this message
338: --mode=MODE - use operation mode MODE
339: --quiet - do not print informational messages
340: --silent - same as `--quiet'
1.5 jasper 341: --tag=TAG - specify a configuration variable TAG
1.1 espie 342: --version - print version of libtool
343: EOF
344: ;
345: exit 1;
346: }
347:
348: sub notyet
349: {
350: die "Option not implemented yet.\n";
351: }
352:
353: sub config
354: {
1.18 jasper 355: while ( my ($key, $value) = each(%$ltconfig) ) {
356: print "$key = $value\n";
357: }
1.1 espie 358: exit 0;
359: }
360:
361: sub create_symlinks
362: {
1.7 espie 363: my ($dir, $libs) = @_;
1.1 espie 364: if (! -d $dir) {
1.7 espie 365: mkdir($dir) or die "Cannot mkdir($dir) : $!\n";
1.1 espie 366: }
1.7 espie 367:
1.1 espie 368: foreach my $l (values %$libs) {
369: my $f = $l->{fullpath};
1.7 espie 370: next if !defined $f;
371: next if $f =~ m/\.a$/;
1.1 espie 372: my $libnames = [];
373: if (defined $l->{lafile}) {
374: require LT::LaFile;
375: my $lainfo = LT::LaFile->parse($l->{lafile});
376: my $librarynames = $lainfo->stringize('library_names');
377: @$libnames = split /\s/, $librarynames;
378: $libnames = reverse_zap_duplicates_ref($libnames);
379: } else {
1.3 espie 380: push @$libnames, basename($f);
1.1 espie 381: }
382: foreach my $libfile (@$libnames) {
1.4 espie 383: my $link = "$dir/$libfile";
1.10 espie 384: tsay {"ln -s $f $link"};
1.7 espie 385: next if -f $link;
386: my $p = abs_path($f);
1.8 espie 387: if (!symlink($p, $link)) {
388: die "Cannot create symlink($p, $link): $!\n"
1.9 espie 389: unless $!{EEXIST};
1.8 espie 390: }
1.1 espie 391: }
392: }
1.7 espie 393: return $dir;
1.1 espie 394: }
395:
![[BACK]](/icons/back.gif){kind=icon}
Return to libtool CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [local] / src / usr.bin / libtool