I wrote:
>I think I'll look into writing a Perl script that will modify
>apu_want.h, apu.hw, and the .dsp files, so that Windows users can link
>apr-util with BDB and incidentally make things work for Subversion. I
>know this is a hack, but it's a first step towards at least partual
>confguratbility of the apr(-util) Win32 build.
>
>
Here's the script; please bang on it. It requires perl-5.8.0 or newer;
earlier versions are notoriously stupid about chomping curlifs, and
don't include the File::Spec module.
Oh yes, the script expects to live in apr-util/build.
--
Brane Čibej <brane_at_xbc.nu> http://www.xbc.nu/brane/
#! 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 abs2rel
splitpath catpath splitdir catdir);
########
# Subroutine prototypes
sub usage();
sub find_srcdir();
sub get_lib_name($$);
sub make_relative($$);
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 $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 $aprutil_dsp" unless -f $aprutil_dsp;
die "Can't find $libaprutil_dsp" unless -f $libaprutil_dsp;
########
# Edit the header file templates
edit_header($apu_hw,
'^\s*\#\s*define\s+APU_HAVE_DB\s+0\s*$',
'#define APU_HAVE_DB 1');
my $rel_db_h = make_relative("$incdir/db.h", "$srcdir/include");
$rel_db_h =~ s/\\/\//g;
edit_header($apu_want_hw,
'^\s*\#\s*include\s+\<db\.h\>\s*$',
"#include \"$rel_db_h\"");
########
# Edit the .dsp files
my $rel_lib_path = make_relative("$libdir/$libname", $srcdir);
edit_project($aprutil_dsp, $rel_lib_path);
edit_project($libaprutil_dsp, $rel_lib_path);
########
# 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;
}
########
# Make the given path relative to a base
sub make_relative($$)
{
my ($path, $base) = @_;
$path = rel2abs(canonpath($path));
$base = rel2abs(canonpath($base));
return abs2rel($path, $base);
}
########
# Replace a file, keeping a backup copy
sub rename_with_backup($$)
{
my ($tmpfile, $file) = @_;
# 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);
}
########
# Edit a header template in-place.
sub edit_header($$$)
{
my ($file, $pattern, $replacement) = @_;
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;
$substs += s/$pattern/$replacement/;
print TMP $_, "\n";
}
close(IN);
close(TMP);
if ($substs > 0) {
rename_with_backup($tmpfile, $file);
} else {
print "No changes in $file\n";
unlink($tmpfile);
}
}
########
# 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 defined $1 and $1 eq '') {
my $fullpath =
($debug eq '1' ? "${libpath}d.lib" : "$libpath.lib");
$substs += s/^\# ADD $prog /\# ADD $prog \"$fullpath\" /;
}
print TMP $_, "\n";
}
close(IN);
close(TMP);
if ($substs > 0) {
rename_with_backup($tmpfile, $file);
} else {
print "No changes in $file\n";
unlink($tmpfile);
}
}
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@subversion.tigris.org
For additional commands, e-mail: dev-help@subversion.tigris.org
Received on Tue Nov 4 02:44:21 2003