1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
#!/usr/bin/perl -w
#
# @(#)$Id: esqlld,v 2005.1 2005/07/25 18:44:55 jleffler Exp $
#
# IBM Informix Database Driver for Perl DBI Version 2008.0513 (2008-05-13)
#
# Surrogate Linker for Informix ESQL/C versions 4.10.UC1 upwards
# -- Used to create shared libraries.
#
# Copyright 1996-99 Jonathan Leffler
# Copyright 2000 Informix Software Inc
# Copyright 2002-03 IBM
# Copyright 2005 Jonathan Leffler
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the Perl README file.
# Ensure we use distributed version of DBD::Informix::Configure,
# not pre-installed out-of-date version of it.
BEGIN
{
unshift @INC, "lib";
use constant debug => ($ENV{DBD_INFORMIX_DEBUG_ESQLLD} ? 1 : 0);
}
use strict;
use DBD::Informix::Configure; # &map_informix_lib_names()
my $map = ($ENV{DBD_INFORMIX_RELOCATABLE_INFORMIXDIR}) ? 0 : 1;
my @ARGS = $map ? &map_informix_lib_names(@ARGV) : @ARGV;
# JL 1997-04-08: Add -lc to command line (reason why no longer known)
push @ARGS, "-lc";
# Remove C preprocessor options from linker command line
@ARGS = grep { !m/^-[DIU]/o } @ARGS;
# Roderick Schertler <roderick@argon.org> 1999-07-27:
# I got "SEVERE LIBC ERROR: CALL TO __mutex_unlock FAILED" when
# linked with -lthread under dgux 4.11.mu05 on m88k. According
# to DG (ticket l574314) that can happen if you use a shared
# library which uses -lthread with one which doesn't. I don't
# know why this never came up before.
@ARGS = grep { !m/^-lthread/o } @ARGS
if ($^O eq 'dgux');
# Remove -g option from linker command line when requested.
# Problem found on SCO 3.2v5.0.2 by Brad Huan-Ming Kao
# <proton@iiidns.iii.org.tw>
@ARGS = grep { !m/^-g$/o } @ARGS
if ($ENV{DBD_INFORMIX_ESQLLD_NO_G_OPTION});
# Generalization of DBD_INFORMIX_ESQLLD_NO_G_OPTION...
if ($ENV{DBD_INFORMIX_ESQLLD_REMOVE_OPTIONS_REGEX})
{
my($env) = $ENV{DBD_INFORMIX_ESQLLD_REMOVE_OPTIONS_REGEX};
print STDERR "# DBD_INFORMIX_ESQLLD_REMOVE_OPTIONS_REGEX set.\n";
print STDERR "# Removing options that match regex m%$env%\n";
print STDERR "# Before: @ARGS\n" if debug;
@ARGS = grep { !m%$env%o } @ARGS;
print STDERR "# After: @ARGS\n" if debug;
}
# How to deal with mapping -xarch=sparcv9 to -m64? Need to provide a
# mechanism to do search/replace. How to specify? qr// only handles
# single regexes, not both parts of s///. So, we can do it with two
# environment variables (one to search, one to replace), or with one
# that contains a complete 's///' pattern. If there are many mappings
# to do (eg -KPIC => -fPIC as well), this may be inadequate.
# Comment: It is surprisingly hard to do this right!
# ******** There has to be a better way using map and a block - surely?
# Note that this code is vulnerable to spaces in arguments. We can
# check for these when they prove to be a problem.
if ($ENV{DBD_INFORMIX_ESQLLD_REPLACE_OPTIONS_REGEX})
{
my($env) = $ENV{DBD_INFORMIX_ESQLLD_REPLACE_OPTIONS_REGEX};
print STDERR "# DBD_INFORMIX_ESQLLD_REPLACE_OPTIONS_REGEX set.\n";
die "Malformed regex ($env) not similar enough to s/a/b/\n"
unless ($env =~ m/^s(.).*\1.*\1$/);
print STDERR "# Replacing options using regex $env\n";
print STDERR "# Before: @ARGS\n" if debug;
my $sub = qq%sub { my(\$s) = "\@_"; \$s =~ ${env}go; return \$s; }%;
print STDERR "# Mapper: $sub\n" if debug;
my $mapper = eval $sub or die "Unable to compile $sub";
@ARGS = split / +/, &$mapper(@ARGS);
print STDERR "# After: @ARGS\n" if debug;
}
# A variant of the code for DBD_INFORMIX_ESQLLD_REPLACE_OPTIONS_REGEX.
# How to deal with removing "-z ignore" - two adjacent options?
# The "-z ignore" option pair, along with "-z lazyload" and "-z
# combreloc", sometimes causes trouble on some Solaris platforms with
# GCC. To remove these - set the env var (its name is deliberately very
# long) to: "-z\s*(ignore|combreloc|lazyload)\b".
# The easiest way is to flatten the arguments into a string, do a global
# delete, and a split (in the calling code?).
# Note that this code is vulnerable to spaces in arguments. We can
# check for these when they prove to be a problem.
# Note that despite the function name, it is perfectly capable of
# removing singletons, triplets, quadruplets, quintuplets, sextuplets,
# septuplets, octuplets, and so on.
sub remove_option_pairs
{
my(@ARGS) = @_;
my($flat) = "@ARGS";
if ($ENV{DBD_INFORMIX_ESQLLD_REMOVE_OPTION_PAIRS})
{
my($env) = $ENV{DBD_INFORMIX_ESQLLD_REMOVE_OPTION_PAIRS};
print STDERR "# DBD_INFORMIX_ESQLLD_REMOVE_OPTION_PAIRS set.\n";
print STDERR "# Removing option pairs that match regex s%$env%%g\n";
print STDERR "# Before: $flat\n";
$flat =~ s%$env%%g;
print STDERR "# After: $flat\n";
}
return "$flat";
}
@ARGS = split / +/, &remove_option_pairs(@ARGS)
if ($ENV{DBD_INFORMIX_ESQLLD_REMOVE_OPTION_PAIRS});
# Sort out the real compiler.
# Note that if $ENV{ESQLLD} contains, for example, 'cc -G', then we
# need to split this into two words for the exec to work correctly.
my $cmd = $ENV{ESQLLD};
$cmd = 'cc' unless ($cmd);
$cmd = &remove_option_pairs($cmd)
if ($ENV{DBD_INFORMIX_ESQLLD_REMOVE_OPTION_PAIRS});
my @cmd = split /\s+/, $cmd;
print STDERR "+ @cmd @ARGS\n" if debug;
exec @cmd, @ARGS;
|
