Annotation of src/usr.bin/libtool/libtool, Revision 1.22
1.1 espie 1: #!/usr/bin/perl
1.22 ! jasper 2: # $OpenBSD: libtool,v 1.21 2012/07/07 21:45:15 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.22 ! jasper 54:
! 55: if (grep { $_ eq $self->{machine_arch} } qw(m88k vax)) {
! 56: $self->{noshared} = 1;
! 57: } else {
! 58: $self->{noshared} = 0;
! 59: }
! 60:
1.18 jasper 61: bless $self, $class;
1.16 jasper 62: }
63:
1.20 jasper 64: sub dump
65: {
66: my $self = shift;
67: while (my ($key, $value) = each(%$self)) {
68: print "$key = $value\n";
69: }
70: }
71:
1.19 espie 72: package LT::Mode;
73:
74: sub new
75: {
76: my ($class, $origin) = @_;
77: # XXX autoload *if needed*.
78: eval "require $class; ";
79: bless {origin => $origin }, $class;
80: }
81:
82: my $mode_maker = { compile => 'LT::Mode::Compile',
83: clean => 'LT::Mode::Clean',
84: execute => 'LT::Mode::Execute',
85: finish => 'LT::Mode::Finish',
86: install => 'LT::Mode::Install',
87: link => 'LT::Mode::Link',
88: uninstall => 'LT::Mode::Uninstall' };
89:
90: sub factory
91: {
92: my ($class, $mode, $origin) = @_;
93: if (defined $mode_maker->{$mode}) {
94: return $mode_maker->{$mode}->new($origin);
95: } else {
96: # XXX invokved from getopt, can't die yet.
97: say STDERR "Mode=$mode not implemented yet.\n";
98: exit 1;
99: }
100: }
101:
102: package LT::Mode::Empty;
103: our @ISA = qw(LT::Mode);
104: sub run
105: {
106: exit 0;
107: }
108: package LT::Mode::Compile;
109: our @ISA = qw(LT::Mode);
110:
111: package LT::Mode::Clean;
112: our @ISA = qw(LT::Mode::Empty);
113:
114: package LT::Mode::Execute;
115: our @ISA = qw(LT::Mode);
116: sub run
117: {
118: my ($class, $ltprog, $gp, $noshared) = @_;
119: # XXX check whether this is right
120: LT::Exec->silent_run;
121: LT::Exec->execute(@$ltprog, @main::ARGV);
122: }
123:
124: package LT::Mode::Finish;
125: our @ISA = qw(LT::Mode::Empty);
126:
127: package LT::Mode::Install;
128: our @ISA = qw(LT::Mode);
129:
130: package LT::Mode::Link;
131: our @ISA = qw(LT::Mode);
132:
133: package LT::Mode::Uninstall;
134: our @ISA = qw(LT::Mode::Empty);
135:
1.10 espie 136: package LT::Options;
137: use Getopt::Long;
138:
139: my @valid_modes = qw(compile clean execute finish install link uninstall);
1.19 espie 140:
1.10 espie 141: my @known_tags = qw(disable-shared disable-static CC CXX F77 FC GO GCJ RC);
142:
143: sub new
144: {
145: my $class = shift;
146: my $o = bless { gp => Getopt::Long::Parser->new }, $class;
147: # require_order so we stop parsing at the first non-option or argument,
148: # instead of parsing the whole ARGV.
149: $o->{gp}->configure('no_ignore_case',
150: 'pass_through',
151: 'no_auto_abbrev',
152: 'require_order');
153: return $o;
154: }
155:
156: sub add_tag
157: {
158: my ($self, $value) = @_;
159: if ($value =~ m/[^\-\w,\/]/) {
160: # XXX stupid Getopt pre-empts die !
161: say STDERR "invalid tag name: $value";
162: exit 1;
163: }
164: if (grep {$value eq $_} @known_tags) {
165: $self->{tags}{$value} = 1;
166: } else {
167: say STDERR "ignoring unknown tag: $value";
168: }
169: }
170:
171: sub has_tag
172: {
173: my ($self, $tag) = @_;
174: return defined $self->{tags}{$tag};
175: }
176:
177: sub configure
178: {
179: my $o = shift;
180: $o->{gp}->configure(@_);
181: }
182:
183: sub getoptions
184: {
185: my $o = shift;
186: $o->{gp}->getoptions(@_);
187: }
188:
189: sub is_abreviated_mode
190: {
191: my ($self, $arg) = @_;
1.15 jasper 192: return undef if !$arg;
1.10 espie 193: for my $m (@valid_modes) {
194: next if length $arg > length $m;
195: if ($arg eq substr($m, 0, length $arg)) {
1.19 espie 196: return LT::Mode->factory($m, $arg);
1.10 espie 197: }
198: }
199: return undef;
200: }
201:
202: # XXX this should always fail if we are libtool2 !
203: # try to guess libtool mode when it is not specified
204: sub guess_implicit_mode
205: {
206: my ($self, $ltprog) = @_;
207: my $m;
208: for my $a (@$ltprog) {
209: if ($a =~ m/(install([.-]sh)?|cp)$/) {
1.19 espie 210: $m = LT::Mode::Install->new("implicit $a");
1.10 espie 211: } elsif ($a =~ m/cc|c\+\+/) { # XXX improve test
212: if (grep { $_ eq '-c' } @ARGV) {
1.19 espie 213: $m = LT::Mode::Compile->new("implicit");
1.10 espie 214: } else {
1.19 espie 215: $m = LT::Mode::Link->new("implicit");
1.10 espie 216: }
217: }
218: }
219: return $m;
220: }
221:
222: sub valid_modes
223: {
224: my $self = shift;
225: return join(' ', @valid_modes);
226: }
227:
228: package main;
1.1 espie 229:
230: use subs qw(
231: create_symlinks
232: help
233: notyet
234: );
235:
1.17 espie 236: my $ltconfig = LT::OSConfig->new;
1.1 espie 237: my $cwd = getcwd();
238: my $mode;
239: my $verbose = 1;
240:
241: # just to be clear:
242: # when building a library:
243: # * -R libdir records libdir in dependency_libs
244: # * -rpath is the path where the (shared) library will be installed
245: # when building a program:
246: # * both -R libdir and -rpath libdir add libdir to the run-time path
247: # -Wl,-rpath,libdir will bypass libtool.
248:
1.10 espie 249: if ($mode = LT::Options->is_abreviated_mode($ARGV[0])) {
250: shift @ARGV;
251: }
252:
253: my $gp = LT::Options->new;
1.1 espie 254: $gp->getoptions('config' => \&config,
1.10 espie 255: 'debug' => sub {
256: LT::Trace->set($_[1]);
257: LT::Exec->verbose_run;
258: },
259: 'dry-run|n' => sub { LT::Exec->dry_run; },
260: 'features' => sub {
261: my $v = `uname -r`;
262: chomp $v;
1.18 jasper 263: say "host: $ltconfig->{gnu_arch}-unknown-openbsd$v";
1.22 ! jasper 264: say "enable shared libraries" unless $ltconfig->{noshared};
1.10 espie 265: say "enable static libraries";
266: exit 0;
267: },
1.19 espie 268: 'finish' => sub { $mode = LT::Mode::Finish->new('--finish'); },
1.1 espie 269: 'help' => \&help, # does not return
1.19 espie 270: 'mode=s{1}' => sub {
271: $mode = LT::Mode->factory($_[1], "--mode=$_[1]");
272: },
1.1 espie 273: 'quiet' => sub { $verbose = 0; },
274: 'silent' => sub { $verbose = 0; },
1.10 espie 275: 'tag=s{1}' => sub { $gp->add_tag($_[1]); },
276: 'version' => sub {
277: say "libtool (not (GNU libtool)) $version" ;
278: exit 0;
279: },
1.1 espie 280: );
281:
1.10 espie 282: if ($verbose) {
1.1 espie 283: LT::Exec->verbose_run;
284: }
1.10 espie 285:
1.1 espie 286: # what are we going to run (cc, c++, ...)
287: my $ltprog = [];
288: # deal with multi-arg ltprog
1.10 espie 289: tsay {"ARGV = \"@ARGV\""};
1.1 espie 290: while (@ARGV) {
291: # just read arguments until the next option...
292: if ($ARGV[0] =~ m/^\-/) { last; }
293: # XXX improve checks
294: if ($ARGV[0] =~ m/^\S+\.la/) { last; }
295: my $arg = shift @ARGV;
296: push @$ltprog, $arg;
1.10 espie 297: tsay {"arg = \"$arg\""};
1.1 espie 298: # if the current argument is an install program, stop immediately
299: if ($arg =~ /cp$/) { last; }
300: if ($arg =~ /install([-.]sh)?$/) { last; }
301: }
1.10 espie 302: tsay {"ltprog = \"@$ltprog\""};
1.14 espie 303:
304: # XXX compat game to satisfy both libtool 1 and libtool 2
305: # let libtool install work as both libtool 1 and libtool 2
1.19 espie 306: if (@$ltprog == 0 && defined $mode && $mode->{origin} eq 'install') {
307: $ltprog = [ 'install' ];
1.14 espie 308: }
1.6 jasper 309: if (@$ltprog == 0) { die "No libtool command given.\n" .
310: "Use `libtool --help' for more information.\n" };
1.1 espie 311: # make ltprog a list of elements without whitespace (prevent exec errors)
312: my @tmp_ltprog = @$ltprog;
313: @$ltprog = ();
314: for my $el (@tmp_ltprog) {
315: my @parts = split /\s+/, $el;
316: push @$ltprog, @parts;
317: }
318:
1.10 espie 319: if (!defined $mode) {
320: $mode = $gp->guess_implicit_mode($ltprog);
1.19 espie 321: tsay {"implicit mode: ", $mode->{origin}} if $mode;
1.1 espie 322: }
323:
324: # from here, options may be intermixed with arguments
325: $gp->configure('permute');
326:
1.22 ! jasper 327: $mode->run($ltprog, $gp, $ltconfig->{noshared});
1.1 espie 328:
329: if (LT::Exec->performed == 0) {
330: die "No commands to execute.\n"
331: }
332:
333: ###########################################################################
334:
335: sub help
336: {
337: print <<EOF
338: Usage: $0 [options]
339: --config - print configuration
340: --debug - turn on debugging output
341: --dry-run - don't do anything, only show what would be done
342: --help - this message
343: --mode=MODE - use operation mode MODE
344: --quiet - do not print informational messages
345: --silent - same as `--quiet'
1.5 jasper 346: --tag=TAG - specify a configuration variable TAG
1.1 espie 347: --version - print version of libtool
348: EOF
349: ;
1.21 jasper 350: exit 0;
1.1 espie 351: }
352:
353: sub notyet
354: {
355: die "Option not implemented yet.\n";
356: }
357:
358: sub config
359: {
1.20 jasper 360: $ltconfig->dump;
1.1 espie 361: exit 0;
362: }
363:
364: sub create_symlinks
365: {
1.7 espie 366: my ($dir, $libs) = @_;
1.1 espie 367: if (! -d $dir) {
1.7 espie 368: mkdir($dir) or die "Cannot mkdir($dir) : $!\n";
1.1 espie 369: }
1.7 espie 370:
1.1 espie 371: foreach my $l (values %$libs) {
372: my $f = $l->{fullpath};
1.7 espie 373: next if !defined $f;
374: next if $f =~ m/\.a$/;
1.1 espie 375: my $libnames = [];
376: if (defined $l->{lafile}) {
377: require LT::LaFile;
378: my $lainfo = LT::LaFile->parse($l->{lafile});
379: my $librarynames = $lainfo->stringize('library_names');
380: @$libnames = split /\s/, $librarynames;
381: $libnames = reverse_zap_duplicates_ref($libnames);
382: } else {
1.3 espie 383: push @$libnames, basename($f);
1.1 espie 384: }
385: foreach my $libfile (@$libnames) {
1.4 espie 386: my $link = "$dir/$libfile";
1.10 espie 387: tsay {"ln -s $f $link"};
1.7 espie 388: next if -f $link;
389: my $p = abs_path($f);
1.8 espie 390: if (!symlink($p, $link)) {
391: die "Cannot create symlink($p, $link): $!\n"
1.9 espie 392: unless $!{EEXIST};
1.8 espie 393: }
1.1 espie 394: }
395: }
1.7 espie 396: return $dir;
1.1 espie 397: }
398:
![[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