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