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
13require 5.008;
14use strict;
15use File::Spec::Functions qw(canonpath rel2abs
16                             splitpath catpath splitdir catdir);
17
18########
19# Subroutine prototypes
20sub usage();
21sub find_srcdir();
22sub get_lib_name($$);
23sub edit_header($$);
24sub edit_project($$);
25
26########
27# Parse program arguments and set globals
28die usage() unless scalar @ARGV >= 3;
29
30my $type = lc($ARGV[0]);
31die "Invalid library type '$type'\n"
32    unless $type eq 'lib' or $type eq 'dll';
33
34my $incdir = $ARGV[1];
35die "No 'db.h' in $incdir\n" unless -f "$incdir/db.h";
36
37my $libdir = $ARGV[2];
38die "$libdir: $!" unless -d $libdir;
39
40my $libname = get_lib_name($type, $incdir);
41die "No '$libname.lib' in $libdir" unless -f "$libdir/$libname.lib";
42die "No '${libname}d.lib' in $libdir" unless -f "$libdir/${libname}d.lib";
43
44my $srcdir = find_srcdir();
45my $apu_hw = canonpath("$srcdir/include/apu.hw");
46my $apu_want_hw = canonpath("$srcdir/include/apu_want.hw");
47my $apu_select_dbm_hw = canonpath("$srcdir/include/private/apu_select_dbm.hw");
48my $aprutil_dsp = canonpath("$srcdir/aprutil.dsp");
49my $libaprutil_dsp = canonpath("$srcdir/libaprutil.dsp");
50die "Can't find $apu_hw" unless -f $apu_hw;
51die "Can't find $apu_want_hw" unless -f $apu_want_hw;
52die "Can't find $apu_select_dbm_hw" unless -f $apu_select_dbm_hw;
53die "Can't find $aprutil_dsp" unless -f $aprutil_dsp;
54die "Can't find $libaprutil_dsp" unless -f $libaprutil_dsp;
55
56
57########
58# Edit the header file templates
59my $db_h = rel2abs(canonpath("$incdir/db.h"));
60$db_h =~ s/\\/\//g;
61edit_header($apu_hw,
62            [['^\s*\#\s*define\s+APU_HAVE_DB\s+0\s*$',
63              '#define APU_HAVE_DB     1']]);
64edit_header($apu_want_hw,
65            [['^\s*\#\s*include\s+\<db\.h\>\s*$',
66              "#include \"$db_h\""]]);
67edit_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
75my $libpath = rel2abs(canonpath("$libdir/$libname"));
76edit_project($aprutil_dsp, $libpath);
77edit_project($libaprutil_dsp, $libpath);
78
79
80########
81# Print usage
82sub 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.
93sub 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
106sub 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
137sub 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.
154sub 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
177sub 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}
218