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