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