apr-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From br...@apache.org
Subject cvs commit: apr-util/build w32locatedb.pl
Date Mon, 10 Nov 2003 22:08:14 GMT
brane       2003/11/10 14:08:14

  Added:       build    w32locatedb.pl
  Log:
  Modify the Win32 headers and build scripts to use Berkeley DB.
  
  Revision  Changes    Path
  1.1                  apr-util/build/w32locatedb.pl
  
  Index: 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);
  }
  
  
  

Mime
View raw message