Annotation of src/usr.bin/libtool/libtool, Revision 1.11
1.1 espie 1: #!/usr/bin/perl
1.11 ! espie 2: # $OpenBSD: libtool,v 1.10 2012/07/04 12:39:34 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: my %opts; # options passed to libtool
161:
162: # just to be clear:
163: # when building a library:
164: # * -R libdir records libdir in dependency_libs
165: # * -rpath is the path where the (shared) library will be installed
166: # when building a program:
167: # * both -R libdir and -rpath libdir add libdir to the run-time path
168: # -Wl,-rpath,libdir will bypass libtool.
169:
170: # build static/shared objects?
171: my $noshared = 0;
172: if (grep { $_ eq $machine_arch } @no_shared_archs) {
173: $noshared = 1;
174: }
175:
1.10 espie 176:
177: if ($mode = LT::Options->is_abreviated_mode($ARGV[0])) {
178: shift @ARGV;
179: }
180:
181: my $gp = LT::Options->new;
1.1 espie 182: $gp->getoptions('config' => \&config,
1.10 espie 183: 'debug' => sub {
184: LT::Trace->set($_[1]);
185: LT::Exec->verbose_run;
186: },
187: 'dry-run|n' => sub { LT::Exec->dry_run; },
188: 'features' => sub {
189: my $v = `uname -r`;
190: chomp $v;
191: say "host: $gnu_arch-unknown-openbsd$v";
192: say "enable shared libraries" unless $noshared;
193: say "enable static libraries";
194: exit 0;
195: },
1.1 espie 196: 'finish' => sub { $mode = 'finish'; },
197: 'help' => \&help, # does not return
198: 'mode=s{1}' => \$mode,
199: 'quiet' => sub { $verbose = 0; },
200: 'silent' => sub { $verbose = 0; },
1.10 espie 201: 'tag=s{1}' => sub { $gp->add_tag($_[1]); },
202: 'version' => sub {
203: say "libtool (not (GNU libtool)) $version" ;
204: exit 0;
205: },
1.1 espie 206: );
207:
1.10 espie 208: if ($verbose) {
1.1 espie 209: LT::Exec->verbose_run;
210: }
1.10 espie 211:
1.1 espie 212: # what are we going to run (cc, c++, ...)
213: my $ltprog = [];
214: # deal with multi-arg ltprog
1.10 espie 215: tsay {"ARGV = \"@ARGV\""};
1.1 espie 216: while (@ARGV) {
217: # just read arguments until the next option...
218: if ($ARGV[0] =~ m/^\-/) { last; }
219: # XXX improve checks
220: if ($ARGV[0] =~ m/^\S+\.la/) { last; }
221: my $arg = shift @ARGV;
222: push @$ltprog, $arg;
1.10 espie 223: tsay {"arg = \"$arg\""};
1.1 espie 224: # if the current argument is an install program, stop immediately
225: if ($arg =~ /cp$/) { last; }
226: if ($arg =~ /install([-.]sh)?$/) { last; }
227: }
1.10 espie 228: tsay {"ltprog = \"@$ltprog\""};
1.6 jasper 229: if (@$ltprog == 0) { die "No libtool command given.\n" .
230: "Use `libtool --help' for more information.\n" };
1.1 espie 231: # make ltprog a list of elements without whitespace (prevent exec errors)
232: my @tmp_ltprog = @$ltprog;
233: @$ltprog = ();
234: for my $el (@tmp_ltprog) {
235: my @parts = split /\s+/, $el;
236: push @$ltprog, @parts;
237: }
238:
1.10 espie 239: if (!defined $mode) {
240: $mode = $gp->guess_implicit_mode($ltprog);
241: tsay {"implicit mode: ", $mode} if $mode;
242: }
243:
244: if (!$gp->is_valid_mode($mode)) {
245: say STDERR "$0: $mode: invalid argument for --mode" if defined $mode;
246: die "MODE must be one of: ", $gp->valid_modes, "\n";
1.1 espie 247: }
248:
249: # from here, options may be intermixed with arguments
250: $gp->configure('permute');
251:
252: if ($mode eq 'compile') {
1.3 espie 253: require LT::Mode::Compile;
1.10 espie 254: LT::Mode::Compile->run($ltprog, $gp, $noshared);
1.3 espie 255: } elsif ($mode eq 'install') {
256: require LT::Mode::Install;
257: LT::Mode::Install->run($ltprog);
1.1 espie 258:
259: } elsif ($mode eq 'link') {
1.3 espie 260: require LT::Mode::Link;
1.10 espie 261: LT::Mode::Link->run($ltprog, $gp, $noshared);
1.1 espie 262: } elsif ($mode eq 'finish' || $mode eq 'clean' || $mode eq 'uninstall') {
263: # don't do anything
264: exit 0;
265: } elsif ($mode eq 'execute') {
266: # XXX check whether this is right
267: LT::Exec->silent_run;
1.3 espie 268: LT::Exec->execute(@$ltprog, @ARGV);
1.1 espie 269: } else {
270: die "MODE=$mode not implemented yet.\n";
271: }
272:
273: if (LT::Exec->performed == 0) {
274: die "No commands to execute.\n"
275: }
276:
277: ###########################################################################
278:
279: sub help
280: {
281: print <<EOF
282: Usage: $0 [options]
283: --config - print configuration
284: --debug - turn on debugging output
285: --dry-run - don't do anything, only show what would be done
286: --help - this message
287: --mode=MODE - use operation mode MODE
288: --quiet - do not print informational messages
289: --silent - same as `--quiet'
1.5 jasper 290: --tag=TAG - specify a configuration variable TAG
1.1 espie 291: --version - print version of libtool
292: EOF
293: ;
294: exit 1;
295: }
296:
297: sub notyet
298: {
299: die "Option not implemented yet.\n";
300: }
301:
302: # XXX incomplete
303: sub config
304: {
305: print "objdir=$ltdir\n";
306: print "arch=$machine_arch\n";
307: print "...\n";
308: exit 0;
309: }
310:
311: sub create_symlinks
312: {
1.7 espie 313: my ($dir, $libs) = @_;
1.1 espie 314: if (! -d $dir) {
1.7 espie 315: mkdir($dir) or die "Cannot mkdir($dir) : $!\n";
1.1 espie 316: }
1.7 espie 317:
1.1 espie 318: foreach my $l (values %$libs) {
319: my $f = $l->{fullpath};
1.7 espie 320: next if !defined $f;
321: next if $f =~ m/\.a$/;
1.1 espie 322: my $libnames = [];
323: if (defined $l->{lafile}) {
324: require LT::LaFile;
325: my $lainfo = LT::LaFile->parse($l->{lafile});
326: my $librarynames = $lainfo->stringize('library_names');
327: @$libnames = split /\s/, $librarynames;
328: $libnames = reverse_zap_duplicates_ref($libnames);
329: } else {
1.3 espie 330: push @$libnames, basename($f);
1.1 espie 331: }
332: foreach my $libfile (@$libnames) {
1.4 espie 333: my $link = "$dir/$libfile";
1.10 espie 334: tsay {"ln -s $f $link"};
1.7 espie 335: next if -f $link;
336: my $p = abs_path($f);
1.8 espie 337: if (!symlink($p, $link)) {
338: die "Cannot create symlink($p, $link): $!\n"
1.9 espie 339: unless $!{EEXIST};
1.8 espie 340: }
1.1 espie 341: }
342: }
1.7 espie 343: return $dir;
1.1 espie 344: }
345:
![[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