rubbos/app/httpd-2.0.64/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 }