build/w32locatedb.pl

#! perl -w
#
# w32locatedb.pl -- Build apr-util with Berkeley DB on Win32
#
# Usage: perl w32locatedb.pl <type> <incdir> <libdir>
#    type:   Library type to link with ('lib' or 'dll')
#    incdir: BDB includes directory (for db.h)
#    libdir: Library directory (for libdbXY[s][d].lib)
#
# This script falls under the Apache License.
# See http://www.apache.org/docs/LICENSE

require 5.008;
use strict;
use File::Spec::Functions qw(canonpath rel2abs
                             splitpath catpath splitdir catdir);

########
# Subroutine prototypes
sub usage();
sub find_srcdir();
sub get_lib_name($$);
sub edit_header($$);
sub edit_project($$);

########
# Parse program arguments and set globals
die usage() unless scalar @ARGV >= 3;

my $type = lc($ARGV[0]);
die "Invalid library type '$type'\n"
    unless $type eq 'lib' or $type eq 'dll';

my $incdir = $ARGV[1];
die "No 'db.h' in $incdir\n" unless -f "$incdir/db.h";

my $libdir = $ARGV[2];
die "$libdir: $!" unless -d $libdir;

my $libname = get_lib_name($type, $incdir);
die "No '$libname.lib' in $libdir" unless -f "$libdir/$libname.lib";
die "No '${libname}d.lib' in $libdir" unless -f "$libdir/${libname}d.lib";

my $srcdir = find_srcdir();
my $apu_hw = canonpath("$srcdir/include/apu.hw");
my $apu_want_hw = canonpath("$srcdir/include/apu_want.hw");
my $apu_select_dbm_hw = canonpath("$srcdir/include/private/apu_select_dbm.hw");
my $aprutil_dsp = canonpath("$srcdir/aprutil.dsp");
my $libaprutil_dsp = canonpath("$srcdir/libaprutil.dsp");
die "Can't find $apu_hw" unless -f $apu_hw;
die "Can't find $apu_want_hw" unless -f $apu_want_hw;
die "Can't find $apu_select_dbm_hw" unless -f $apu_select_dbm_hw;
die "Can't find $aprutil_dsp" unless -f $aprutil_dsp;
die "Can't find $libaprutil_dsp" unless -f $libaprutil_dsp;


########
# Edit the header file templates
my $db_h = rel2abs(canonpath("$incdir/db.h"));
$db_h =~ s/\\/\//g;
edit_header($apu_hw,
            [['^\s*\#\s*define\s+APU_HAVE_DB\s+0\s*$',
              '#define APU_HAVE_DB     1']]);
edit_header($apu_want_hw,
            [['^\s*\#\s*include\s+\<db\.h\>\s*$',
              "#include \"$db_h\""]]);
edit_header($apu_select_dbm_hw,
            [['^\s*\#\s*define\s+APU_USE_DB\s+0\s*$',
              '#define APU_USE_DB      1'],
             ['^\s*\#\s*include\s+\<db\.h\>\s*$',
              "#include \"$db_h\""]]);

########
# Edit the .dsp files
my $libpath = rel2abs(canonpath("$libdir/$libname"));
edit_project($aprutil_dsp, $libpath);
edit_project($libaprutil_dsp, $libpath);


########
# Print usage
sub usage()
{
    return ("Usage: perl w32locatedb.pl <type> <incdir> <libdir>\n"
            . "    type:   Library type to link with ('lib' or 'dll')\n"
            . "    incdir: BDB includes directory (for db.h)\n"
            . "    libdir: Library directory (for libdbXY[s][d].lib)\n");
}

########
# Calculate the (possibly relative) path to the top of the apr-util
# source dir.
sub find_srcdir()
{
    my $srcdir = rel2abs(canonpath($0));
    my ($vol, $dir, $file) = splitpath($srcdir);
    my @dirs = splitdir($dir);
    die if scalar @dirs < 1;
    do { $_ = pop @dirs } while ($_ eq '');
    return catpath($vol, catdir(@dirs), '');
}

########
# Construct the name of the BDB library, based on the type and
# version information in db.h
sub get_lib_name($$)
{
    my ($type, $incdir) = @_;
    my $major = undef;
    my $minor = undef;
    my $patch = undef;

    open(DBH, "< $incdir/db.h")
        or die "Can't open $incdir/db.h: $!";
    while (<DBH>) {
        chomp;
        m/^\s*\#\s*define\s+DB_VERSION_(MAJOR|MINOR|PATCH)\s+(\d+)\s*$/;
        next unless defined $1 and defined $2;
        if    ($1 eq 'MAJOR') { $major = $2; }
        elsif ($1 eq 'MINOR') { $minor = $2; }
        elsif ($1 eq 'PATCH') { $patch = $2; }
        last if defined $major and defined $minor and defined $patch;
    }
    close(DBH);
    die "Can't determine BDB version\n"
        unless defined $major and defined $minor and defined $patch;

    print "Using BDB version $major.$minor.$patch\n";

    my $libname = "libdb$major$minor";
    $libname .= 's' if $type eq 'lib';
    return $libname;
}

########
# Replace a file, keeping a backup copy
sub maybe_rename_with_backup($$$)
{
    my ($tmpfile, $file, $maybe) = @_;
    if ($maybe) {
        # Make the file writable by the owner. On Windows, this removes
        # any read-only bits.
        chmod((stat($file))[2] | 0600, $file);
        rename($file, "${file}~");
        rename($tmpfile, $file);
    } else {
        print "No changes in $file\n";
        unlink($tmpfile);
    }
}

########
# Edit a header template in-place.
sub edit_header($$)
{
    my ($file, $pairs) = @_;
    my $tmpfile = "$file.tmp";
    my $substs = 0;

    open(IN, "< $file") or die "Can't open $file: $!";
    open(TMP, "> $tmpfile") or die "Can't open $tmpfile: $!";
    while (<IN>) {
        chomp;
        foreach my $pair (@$pairs) {
            $substs += s/${$pair}[0]/${$pair}[1]/;
        }
        print TMP $_, "\n";
    }
    close(IN);
    close(TMP);

    maybe_rename_with_backup($tmpfile, $file, $substs > 0);
}

########
# Edit a project file in-place
sub edit_project($$)
{
    my ($file, $libpath) = @_;
    my $tmpfile = "$file.tmp";
    my $substs = 0;
    my ($prog, $debug) = (undef, undef);

    my $libsearch = $libpath;
    $libsearch =~ s/\\/\\\\/g;

    open(IN, "< $file") or die "Can't open $file: $!";
    open(TMP, "> $tmpfile") or die "Can't open $tmpfile: $!";
    while (<IN>) {
        chomp;

        if (m/^\# TARGTYPE \"[^\"]+\" 0x([0-9A-Za-z]+)/
            and defined $1) {
            $prog = 'LINK32' if $1 eq '0102';
            $prog = 'LIB32' if $1 eq '0104';
            die "Unknown project type 0x$1" unless defined $prog;
        } elsif (defined $prog
                 and m/^\# PROP Use_Debug_Libraries ([01])/
                 and defined $1) {
            $debug = $1;
        } elsif (defined $prog and defined $debug
                 and m/^\# ADD $prog (\"$libsearch)?/
                 and not defined $1) {
            my $fullpath =
                ($debug eq '1' ? "${libpath}d.lib" : "$libpath.lib");
            $substs += s/^\# ADD $prog /\# ADD $prog \"$fullpath\" /;
        } elsif (m/^\# ADD CPP/) {
            $substs += s/APU_USE_SDBM/APU_USE_DB/g;
        }

        print TMP $_, "\n";
    }
    close(IN);
    close(TMP);

    maybe_rename_with_backup($tmpfile, $file, $substs > 0);
}