← Back to branch summary

~ubuntu-branches/ubuntu/feisty/apache2/feisty

« back to all changes in this revision

Viewing changes to srclib/apr-util/build/w32locatedb.pl

  • Committer: Bazaar Package Importer
  • Author(s): Andreas Barth
  • Date: 2006-12-09 21:05:45 UTC
  • mfrom: (0.6.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20061209210545-h70s0xaqc2v8vqr2
Tags: 2.2.3-3.2
http://bugs.debian.org/396265
* Non-maintainer upload.
* 043_ajp_connection_reuse: Patch from upstream Bugzilla, fixing a critical
  issue with regard to connection reuse in mod_proxy_ajp.
  Closes: #396265

Show diffs side-by-side

added added

removed removed

Lines of Context:
srclib/apr-util/build/w32locatedb.pl
 
1
#! perl -w
 
2
#
 
3
# w32locatedb.pl -- Build apr-util with Berkeley DB on Win32
 
4
#
 
5
# Usage: perl w32locatedb.pl <type> <incdir> <libdir>
 
6
#    type:   Library type to link with ('lib' or 'dll')
 
7
#    incdir: BDB includes directory (for db.h)
 
8
#    libdir: Library directory (for libdbXY[s][d].lib)
 
9
#
 
10
# This script falls under the Apache License.
 
11
# See http://www.apache.org/docs/LICENSE
 
12
 
 
13
require 5.008;
 
14
use strict;
 
15
use File::Spec::Functions qw(canonpath rel2abs
 
16
                             splitpath catpath splitdir catdir);
 
17
 
 
18
########
 
19
# Subroutine prototypes
 
20
sub usage();
 
21
sub find_srcdir();
 
22
sub get_lib_name($$);
 
23
sub edit_header($$);
 
24
sub edit_project($$);
 
25
 
 
26
########
 
27
# Parse program arguments and set globals
 
28
die usage() unless scalar @ARGV >= 3;
 
29
 
 
30
my $type = lc($ARGV[0]);
 
31
die "Invalid library type '$type'\n"
 
32
    unless $type eq 'lib' or $type eq 'dll';
 
33
 
 
34
my $incdir = $ARGV[1];
 
35
die "No 'db.h' in $incdir\n" unless -f "$incdir/db.h";
 
36
 
 
37
my $libdir = $ARGV[2];
 
38
die "$libdir: $!" unless -d $libdir;
 
39
 
 
40
my $libname = get_lib_name($type, $incdir);
 
41
die "No '$libname.lib' in $libdir" unless -f "$libdir/$libname.lib";
 
42
die "No '${libname}d.lib' in $libdir" unless -f "$libdir/${libname}d.lib";
 
43
 
 
44
my $srcdir = find_srcdir();
 
45
my $apu_hw = canonpath("$srcdir/include/apu.hw");
 
46
my $apu_want_hw = canonpath("$srcdir/include/apu_want.hw");
 
47
my $apu_select_dbm_hw = canonpath("$srcdir/include/private/apu_select_dbm.hw");
 
48
my $aprutil_dsp = canonpath("$srcdir/aprutil.dsp");
 
49
my $libaprutil_dsp = canonpath("$srcdir/libaprutil.dsp");
 
50
die "Can't find $apu_hw" unless -f $apu_hw;
 
51
die "Can't find $apu_want_hw" unless -f $apu_want_hw;
 
52
die "Can't find $apu_select_dbm_hw" unless -f $apu_select_dbm_hw;
 
53
die "Can't find $aprutil_dsp" unless -f $aprutil_dsp;
 
54
die "Can't find $libaprutil_dsp" unless -f $libaprutil_dsp;
 
55
 
 
56
 
 
57
########
 
58
# Edit the header file templates
 
59
my $db_h = rel2abs(canonpath("$incdir/db.h"));
 
60
$db_h =~ s/\\/\//g;
 
61
edit_header($apu_hw,
 
62
            [['^\s*\#\s*define\s+APU_HAVE_DB\s+0\s*$',
 
63
              '#define APU_HAVE_DB     1']]);
 
64
edit_header($apu_want_hw,
 
65
            [['^\s*\#\s*include\s+\<db\.h\>\s*$',
 
66
              "#include \"$db_h\""]]);
 
67
edit_header($apu_select_dbm_hw,
 
68
            [['^\s*\#\s*define\s+APU_USE_DB\s+0\s*$',
 
69
              '#define APU_USE_DB      1'],
 
70
             ['^\s*\#\s*include\s+\<db\.h\>\s*$',
 
71
              "#include \"$db_h\""]]);
 
72
 
 
73
########
 
74
# Edit the .dsp files
 
75
my $libpath = rel2abs(canonpath("$libdir/$libname"));
 
76
edit_project($aprutil_dsp, $libpath);
 
77
edit_project($libaprutil_dsp, $libpath);
 
78
 
 
79
 
 
80
########
 
81
# Print usage
 
82
sub usage()
 
83
{
 
84
    return ("Usage: perl w32locatedb.pl <type> <incdir> <libdir>\n"
 
85
            . "    type:   Library type to link with ('lib' or 'dll')\n"
 
86
            . "    incdir: BDB includes directory (for db.h)\n"
 
87
            . "    libdir: Library directory (for libdbXY[s][d].lib)\n");
 
88
}
 
89
 
 
90
########
 
91
# Calculate the (possibly relative) path to the top of the apr-util
 
92
# source dir.
 
93
sub find_srcdir()
 
94
{
 
95
    my $srcdir = rel2abs(canonpath($0));
 
96
    my ($vol, $dir, $file) = splitpath($srcdir);
 
97
    my @dirs = splitdir($dir);
 
98
    die if scalar @dirs < 1;
 
99
    do { $_ = pop @dirs } while ($_ eq '');
 
100
    return catpath($vol, catdir(@dirs), '');
 
101
}
 
102
 
 
103
########
 
104
# Construct the name of the BDB library, based on the type and
 
105
# version information in db.h
 
106
sub get_lib_name($$)
 
107
{
 
108
    my ($type, $incdir) = @_;
 
109
    my $major = undef;
 
110
    my $minor = undef;
 
111
    my $patch = undef;
 
112
 
 
113
    open(DBH, "< $incdir/db.h")
 
114
        or die "Can't open $incdir/db.h: $!";
 
115
    while (<DBH>) {
 
116
        chomp;
 
117
        m/^\s*\#\s*define\s+DB_VERSION_(MAJOR|MINOR|PATCH)\s+(\d+)\s*$/;
 
118
        next unless defined $1 and defined $2;
 
119
        if    ($1 eq 'MAJOR') { $major = $2; }
 
120
        elsif ($1 eq 'MINOR') { $minor = $2; }
 
121
        elsif ($1 eq 'PATCH') { $patch = $2; }
 
122
        last if defined $major and defined $minor and defined $patch;
 
123
    }
 
124
    close(DBH);
 
125
    die "Can't determine BDB version\n"
 
126
        unless defined $major and defined $minor and defined $patch;
 
127
 
 
128
    print "Using BDB version $major.$minor.$patch\n";
 
129
 
 
130
    my $libname = "libdb$major$minor";
 
131
    $libname .= 's' if $type eq 'lib';
 
132
    return $libname;
 
133
}
 
134
 
 
135
########
 
136
# Replace a file, keeping a backup copy
 
137
sub maybe_rename_with_backup($$$)
 
138
{
 
139
    my ($tmpfile, $file, $maybe) = @_;
 
140
    if ($maybe) {
 
141
        # Make the file writable by the owner. On Windows, this removes
 
142
        # any read-only bits.
 
143
        chmod((stat($file))[2] | 0600, $file);
 
144
        rename($file, "${file}~");
 
145
        rename($tmpfile, $file);
 
146
    } else {
 
147
        print "No changes in $file\n";
 
148
        unlink($tmpfile);
 
149
    }
 
150
}
 
151
 
 
152
########
 
153
# Edit a header template in-place.
 
154
sub edit_header($$)
 
155
{
 
156
    my ($file, $pairs) = @_;
 
157
    my $tmpfile = "$file.tmp";
 
158
    my $substs = 0;
 
159
 
 
160
    open(IN, "< $file") or die "Can't open $file: $!";
 
161
    open(TMP, "> $tmpfile") or die "Can't open $tmpfile: $!";
 
162
    while (<IN>) {
 
163
        chomp;
 
164
        foreach my $pair (@$pairs) {
 
165
            $substs += s/${$pair}[0]/${$pair}[1]/;
 
166
        }
 
167
        print TMP $_, "\n";
 
168
    }
 
169
    close(IN);
 
170
    close(TMP);
 
171
 
 
172
    maybe_rename_with_backup($tmpfile, $file, $substs > 0);
 
173
}
 
174
 
 
175
########
 
176
# Edit a project file in-place
 
177
sub edit_project($$)
 
178
{
 
179
    my ($file, $libpath) = @_;
 
180
    my $tmpfile = "$file.tmp";
 
181
    my $substs = 0;
 
182
    my ($prog, $debug) = (undef, undef);
 
183
 
 
184
    my $libsearch = $libpath;
 
185
    $libsearch =~ s/\\/\\\\/g;
 
186
 
 
187
    open(IN, "< $file") or die "Can't open $file: $!";
 
188
    open(TMP, "> $tmpfile") or die "Can't open $tmpfile: $!";
 
189
    while (<IN>) {
 
190
        chomp;
 
191
 
 
192
        if (m/^\# TARGTYPE \"[^\"]+\" 0x([0-9A-Za-z]+)/
 
193
            and defined $1) {
 
194
            $prog = 'LINK32' if $1 eq '0102';
 
195
            $prog = 'LIB32' if $1 eq '0104';
 
196
            die "Unknown project type 0x$1" unless defined $prog;
 
197
        } elsif (defined $prog
 
198
                 and m/^\# PROP Use_Debug_Libraries ([01])/
 
199
                 and defined $1) {
 
200
            $debug = $1;
 
201
        } elsif (defined $prog and defined $debug
 
202
                 and m/^\# ADD $prog (\"$libsearch)?/
 
203
                 and not defined $1) {
 
204
            my $fullpath =
 
205
                ($debug eq '1' ? "${libpath}d.lib" : "$libpath.lib");
 
206
            $substs += s/^\# ADD $prog /\# ADD $prog \"$fullpath\" /;
 
207
        } elsif (m/^\# ADD CPP/) {
 
208
            $substs += s/APU_USE_SDBM/APU_USE_DB/g;
 
209
        }
 
210
 
 
211
        print TMP $_, "\n";
 
212
    }
 
213
    close(IN);
 
214
    close(TMP);
 
215
 
 
216
    maybe_rename_with_backup($tmpfile, $file, $substs > 0);
 
217
}