Annotation of src/usr.bin/libtool/libtool, Revision 1.25
1.1 espie 1: #!/usr/bin/perl
1.25 ! espie 2: # $OpenBSD: libtool,v 1.24 2012/07/08 12:29:21 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);
1.23 espie 22: use Cwd qw(getcwd);
1.1 espie 23: use File::Glob ':glob';
24: use File::Path;
1.3 espie 25:
1.1 espie 26: use LT::Trace;
27: use LT::Exec;
28: use LT::Util;
1.23 espie 29: use LT::Getopt;
1.1 espie 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,
1.24 jasper 52: version => $version,
53: pic_flags => join(' ', @picflags),
1.18 jasper 54: };
1.19 espie 55: ($self->{gnu_arch} = $self->{machine_arch}) =~ s/amd64/x86_64/;
1.22 jasper 56:
57: if (grep { $_ eq $self->{machine_arch} } qw(m88k vax)) {
58: $self->{noshared} = 1;
59: } else {
60: $self->{noshared} = 0;
61: }
62:
1.18 jasper 63: bless $self, $class;
1.16 jasper 64: }
65:
1.20 jasper 66: sub dump
67: {
68: my $self = shift;
69: while (my ($key, $value) = each(%$self)) {
70: print "$key = $value\n";
71: }
72: }
73:
1.19 espie 74: package LT::Mode;
1.23 espie 75: use LT::Util;
1.19 espie 76:
77: sub new
78: {
79: my ($class, $origin) = @_;
80: # XXX autoload *if needed*.
81: eval "require $class; ";
82: bless {origin => $origin }, $class;
83: }
84:
85: my $mode_maker = { compile => 'LT::Mode::Compile',
86: clean => 'LT::Mode::Clean',
87: execute => 'LT::Mode::Execute',
88: finish => 'LT::Mode::Finish',
89: install => 'LT::Mode::Install',
90: link => 'LT::Mode::Link',
91: uninstall => 'LT::Mode::Uninstall' };
92:
93: sub factory
94: {
95: my ($class, $mode, $origin) = @_;
96: if (defined $mode_maker->{$mode}) {
97: return $mode_maker->{$mode}->new($origin);
98: } else {
1.23 espie 99: shortdie "Mode=$mode not implemented yet.\n";
1.19 espie 100: }
101: }
102:
103: package LT::Mode::Empty;
104: our @ISA = qw(LT::Mode);
105: sub run
106: {
107: exit 0;
108: }
109: package LT::Mode::Compile;
110: our @ISA = qw(LT::Mode);
111:
112: package LT::Mode::Clean;
113: our @ISA = qw(LT::Mode::Empty);
114:
115: package LT::Mode::Execute;
116: our @ISA = qw(LT::Mode);
117: sub run
118: {
119: my ($class, $ltprog, $gp, $noshared) = @_;
120: # XXX check whether this is right
121: LT::Exec->silent_run;
122: LT::Exec->execute(@$ltprog, @main::ARGV);
123: }
124:
125: package LT::Mode::Finish;
126: our @ISA = qw(LT::Mode::Empty);
127:
128: package LT::Mode::Install;
129: our @ISA = qw(LT::Mode);
130:
131: package LT::Mode::Link;
132: our @ISA = qw(LT::Mode);
133:
134: package LT::Mode::Uninstall;
135: our @ISA = qw(LT::Mode::Empty);
136:
1.10 espie 137: package LT::Options;
138: use Getopt::Long;
1.23 espie 139: use LT::Util;
140: our @ISA = qw(LT::Getopt);
1.10 espie 141:
142: my @valid_modes = qw(compile clean execute finish install link uninstall);
1.19 espie 143:
1.10 espie 144: my @known_tags = qw(disable-shared disable-static CC CXX F77 FC GO GCJ RC);
145:
146: sub new
147: {
148: my $class = shift;
149: my $o = bless { gp => Getopt::Long::Parser->new }, $class;
150: # require_order so we stop parsing at the first non-option or argument,
151: # instead of parsing the whole ARGV.
152: $o->{gp}->configure('no_ignore_case',
153: 'pass_through',
154: 'no_auto_abbrev',
155: 'require_order');
156: return $o;
157: }
158:
159: sub add_tag
160: {
161: my ($self, $value) = @_;
162: if ($value =~ m/[^\-\w,\/]/) {
1.23 espie 163: shortdie "invalid tag name: $value";
1.10 espie 164: exit 1;
165: }
166: if (grep {$value eq $_} @known_tags) {
167: $self->{tags}{$value} = 1;
168: } else {
169: say STDERR "ignoring unknown tag: $value";
170: }
171: }
172:
173: sub has_tag
174: {
175: my ($self, $tag) = @_;
176: return defined $self->{tags}{$tag};
177: }
178:
179: sub configure
180: {
181: my $o = shift;
182: $o->{gp}->configure(@_);
183: }
184:
185: sub getoptions
186: {
187: my $o = shift;
188: $o->{gp}->getoptions(@_);
189: }
190:
191: sub is_abreviated_mode
192: {
193: my ($self, $arg) = @_;
1.15 jasper 194: return undef if !$arg;
1.10 espie 195: for my $m (@valid_modes) {
196: next if length $arg > length $m;
197: if ($arg eq substr($m, 0, length $arg)) {
1.19 espie 198: return LT::Mode->factory($m, $arg);
1.10 espie 199: }
200: }
201: return undef;
202: }
203:
204: # XXX this should always fail if we are libtool2 !
205: # try to guess libtool mode when it is not specified
206: sub guess_implicit_mode
207: {
208: my ($self, $ltprog) = @_;
209: my $m;
210: for my $a (@$ltprog) {
211: if ($a =~ m/(install([.-]sh)?|cp)$/) {
1.19 espie 212: $m = LT::Mode::Install->new("implicit $a");
1.10 espie 213: } elsif ($a =~ m/cc|c\+\+/) { # XXX improve test
214: if (grep { $_ eq '-c' } @ARGV) {
1.19 espie 215: $m = LT::Mode::Compile->new("implicit");
1.10 espie 216: } else {
1.19 espie 217: $m = LT::Mode::Link->new("implicit");
1.10 espie 218: }
219: }
220: }
221: return $m;
222: }
223:
224: sub valid_modes
225: {
226: my $self = shift;
227: return join(' ', @valid_modes);
228: }
229:
230: package main;
1.1 espie 231:
232: use subs qw(
233: help
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.25 ! espie 254: $gp->handle_options(
! 255: '-config' => \&config,
! 256: '-debug|x' => sub {
! 257: LT::Trace->set(1);
! 258: LT::Exec->verbose_run;
! 259: },
! 260: '-dry-run|-dryrun|n' => sub { LT::Exec->dry_run; },
! 261: '-features' => sub {
! 262: my $v = `uname -r`;
! 263: chomp $v;
! 264: say "host: $ltconfig->{gnu_arch}-unknown-openbsd$v";
! 265: say "enable shared libraries" unless $ltconfig->{noshared};
! 266: say "enable static libraries";
! 267: exit 0;
! 268: },
! 269: '-finish' => sub { $mode = LT::Mode::Finish->new('--finish'); },
! 270: '-help|-help-all?|h' => \&help, # does not return
! 271: '-mode=' => sub {
! 272: $mode = LT::Mode->factory($_[2], "--mode=$_[2]");
! 273: },
! 274: '-quiet|-silent|-no-verbose' => sub { $verbose = 0; },
! 275: '-verbose|-no-silent|-no-quiet|v' => sub {$verbose = 1;},
! 276: '-tag=' => sub { $gp->add_tag($_[2]); },
! 277: '-version' => sub {
! 278: say "libtool (not (GNU libtool)) $ltconfig->{version}";
! 279: exit 0;
! 280: },
! 281: '-no-warning|-no-warn' -> sub {},
! 282: # -preserve-dup-deps
! 283: # dlopen|-dlopen
! 284: );
1.1 espie 285:
1.10 espie 286: if ($verbose) {
1.1 espie 287: LT::Exec->verbose_run;
288: }
1.10 espie 289:
1.1 espie 290: # what are we going to run (cc, c++, ...)
291: my $ltprog = [];
292: # deal with multi-arg ltprog
1.10 espie 293: tsay {"ARGV = \"@ARGV\""};
1.1 espie 294: while (@ARGV) {
295: # just read arguments until the next option...
296: if ($ARGV[0] =~ m/^\-/) { last; }
297: # XXX improve checks
298: if ($ARGV[0] =~ m/^\S+\.la/) { last; }
299: my $arg = shift @ARGV;
300: push @$ltprog, $arg;
1.10 espie 301: tsay {"arg = \"$arg\""};
1.1 espie 302: # if the current argument is an install program, stop immediately
303: if ($arg =~ /cp$/) { last; }
304: if ($arg =~ /install([-.]sh)?$/) { last; }
305: }
1.10 espie 306: tsay {"ltprog = \"@$ltprog\""};
1.14 espie 307:
308: # XXX compat game to satisfy both libtool 1 and libtool 2
309: # let libtool install work as both libtool 1 and libtool 2
1.19 espie 310: if (@$ltprog == 0 && defined $mode && $mode->{origin} eq 'install') {
311: $ltprog = [ 'install' ];
1.14 espie 312: }
1.6 jasper 313: if (@$ltprog == 0) { die "No libtool command given.\n" .
314: "Use `libtool --help' for more information.\n" };
1.1 espie 315: # make ltprog a list of elements without whitespace (prevent exec errors)
316: my @tmp_ltprog = @$ltprog;
317: @$ltprog = ();
318: for my $el (@tmp_ltprog) {
319: my @parts = split /\s+/, $el;
320: push @$ltprog, @parts;
321: }
322:
1.10 espie 323: if (!defined $mode) {
324: $mode = $gp->guess_implicit_mode($ltprog);
1.19 espie 325: tsay {"implicit mode: ", $mode->{origin}} if $mode;
1.1 espie 326: }
327:
328: # from here, options may be intermixed with arguments
329: $gp->configure('permute');
330:
1.22 jasper 331: $mode->run($ltprog, $gp, $ltconfig->{noshared});
1.1 espie 332:
333: if (LT::Exec->performed == 0) {
334: die "No commands to execute.\n"
335: }
336:
337: ###########################################################################
338:
339: sub help
340: {
341: print <<EOF
342: Usage: $0 [options]
343: --config - print configuration
344: --debug - turn on debugging output
345: --dry-run - don't do anything, only show what would be done
346: --help - this message
347: --mode=MODE - use operation mode MODE
348: --quiet - do not print informational messages
349: --silent - same as `--quiet'
1.5 jasper 350: --tag=TAG - specify a configuration variable TAG
1.1 espie 351: --version - print version of libtool
352: EOF
353: ;
1.21 jasper 354: exit 0;
1.1 espie 355: }
356:
357: sub config
358: {
1.20 jasper 359: $ltconfig->dump;
1.1 espie 360: exit 0;
361: }
362:
![[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