Turn most vc build scripts into modules instead of scripts, and just have

skeleton scripts calling them. To make it easier for the buildfarm
(or other "outside callers") to use these modules directly.

Per suggestion from Andrew Dunstan.

src/tools/msvc/Genbki.pm

+#!/usr/bin/perl
+#-------------------------------------------------------------------------
+#
+# Genbki.pm --
+#    perl script which generates .bki files from specially formatted .h
+#    files.  These .bki files are used to initialize the postgres template
+#    database.
+#
+# Portions Copyright (c) 1996-2007, PostgreSQL Global Development Group
+# Portions Copyright (c) 1994, Regents of the University of California
+#
+#
+# IDENTIFICATION
+#    $PostgreSQL: pgsql/src/tools/msvc/Genbki.pm,v 1.1 2007/03/17 13:50:42 mha Exp $
+#
+#-------------------------------------------------------------------------
+
+package Genbki;
+
+use strict;
+use warnings;
+
+use Exporter;
+our (@ISA, @EXPORT_OK);
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(genbki);
+
+sub genbki
+{
+    my $version = shift;
+    my $prefix = shift;
+
+    $version =~ /^(\d+\.\d+)/ || die "Bad format verison $version\n";
+    my $majorversion = $1;
+
+    my $pgext = read_file("src/include/pg_config_manual.h");
+    $pgext =~ /^#define\s+NAMEDATALEN\s+(\d+)$/mg
+      || die "Could not read NAMEDATALEN from pg_config_manual.h\n";
+    my $namedatalen = $1;
+
+    my $pgauthid = read_file("src/include/catalog/pg_authid.h");
+    $pgauthid =~ /^#define\s+BOOTSTRAP_SUPERUSERID\s+(\d+)$/mg
+      || die "Could not read BOOTSTRAUP_SUPERUSERID from pg_authid.h\n";
+    my $bootstrapsuperuserid = $1;
+
+    my $pgnamespace = read_file("src/include/catalog/pg_namespace.h");
+    $pgnamespace =~ /^#define\s+PG_CATALOG_NAMESPACE\s+(\d+)$/mg
+      || die "Could not read PG_CATALOG_NAMESPACE from pg_namespace.h\n";
+    my $pgcatalognamespace = $1;
+
+    my $indata = "";
+
+    while (@_)
+    {
+        my $f = shift;
+        next unless $f;
+        $indata .= read_file($f);
+        $indata .= "\n";
+    }
+
+    # Strip C comments, from perl FAQ 4.27
+    $indata =~ s{/\*.*?\*/}{}gs;
+
+    $indata =~ s{;\s*$}{}gm;
+    $indata =~ s{^\s+}{}gm;
+    $indata =~ s{^Oid}{oid}gm;
+    $indata =~ s{\(Oid}{(oid}gm;
+    $indata =~ s{^NameData}{name}gm;
+    $indata =~ s{\(NameData}{(name}g;
+    $indata =~ s{^TransactionId}{xid}gm;
+    $indata =~ s{\(TransactionId}{(xid}g;
+    $indata =~ s{PGUID}{$bootstrapsuperuserid}g;
+    $indata =~ s{NAMEDATALEN}{$namedatalen}g;
+    $indata =~ s{PGNSP}{$pgcatalognamespace}g;
+
+    #print $indata;
+
+    my $bki = "";
+    my $desc = "";
+    my $shdesc = "";
+
+    my $oid = 0;
+    my $catalog = 0;
+    my $reln_open = 0;
+    my $bootstrap = "";
+    my $shared_relation = "";
+    my $without_oids = "";
+    my $nc = 0;
+    my $inside = 0;
+    my @attr;
+    my @types;
+
+    foreach my $line (split /\n/, $indata)
+    {
+        if ($line =~ /^DATA\((.*)\)$/m)
+        {
+            my $data = $1;
+            my @fields = split /\s+/,$data;
+            if ($#fields >=4 && $fields[0] eq "insert" && $fields[1] eq "OID" && $fields[2] eq "=")
+            {
+                $oid = $fields[3];
+            }
+            else
+            {
+                $oid = 0;
+            }
+            $data =~ s/\s{2,}/ /g;
+            $bki .= $data . "\n";
+        }
+        elsif ($line =~ /^DESCR\("(.*)"\)$/m)
+        {
+            if ($oid != 0)
+            {
+                $desc .= sprintf("%d\t%s\t0\t%s\n", $oid, $catalog, $1);
+            }
+        }
+        elsif ($line =~ /^SHDESCR\("(.*)"\)$/m)
+        {
+            if ($oid != 0)
+            {
+                $shdesc .= sprintf("%d\t%s\t%s\n", $oid, $catalog, $1);
+            }
+        }
+        elsif ($line =~ /^DECLARE_(UNIQUE_)?INDEX\((.*)\)$/m)
+        {
+            if ($reln_open)
+            {
+                $bki .= "close $catalog\n";
+                $reln_open = 0;
+            }
+            my $u = $1?" unique":"";
+            my @fields = split /,/,$2,3;
+            $fields[2] =~ s/\s{2,}/ /g;
+            $bki .= "declare$u index $fields[0] $fields[1] $fields[2]\n";
+        }
+        elsif ($line =~ /^DECLARE_TOAST\((.*)\)$/m)
+        {
+            if ($reln_open)
+            {
+                $bki .= "close $catalog\n";
+                $reln_open = 0;
+            }
+            my @fields = split /,/,$1;
+            $bki .= "declare toast $fields[1] $fields[2] on $fields[0]\n";
+        }
+        elsif ($line =~ /^BUILD_INDICES/)
+        {
+            $bki .= "build indices\n";
+        }
+        elsif ($line =~ /^CATALOG\((.*)\)(.*)$/m)
+        {
+            if ($reln_open)
+            {
+                $bki .= "close $catalog\n";
+                $reln_open = 0;
+            }
+            my $rest = $2;
+            my @fields = split /,/,$1;
+            $catalog = $fields[0];
+            $oid = $fields[1];
+            $bootstrap=$shared_relation=$without_oids="";
+            if ($rest =~ /BKI_BOOTSTRAP/)
+            {
+                $bootstrap = "bootstrap ";
+            }
+            if ($rest =~ /BKI_SHARED_RELATION/)
+            {
+                $shared_relation = "shared_relation ";
+            }
+            if ($rest =~ /BKI_WITHOUT_OIDS/)
+            {
+                $without_oids = "without_oids ";
+            }
+            $nc++;
+            $inside = 1;
+            next;
+        }
+        if ($inside==1)
+        {
+            next if ($line =~ /{/);
+            if ($line =~ /}/)
+            {
+
+                # Last line
+                $bki .= "create $bootstrap$shared_relation$without_oids$catalog $oid\n (\n";
+                my $first = 1;
+                for (my $i = 0; $i <= $#attr; $i++)
+                {
+                    if ($first == 1)
+                    {
+                        $first = 0;
+                    }
+                    else
+                    {
+                        $bki .= ",\n";
+                    }
+                    $bki .= " " . $attr[$i] . " = " . $types[$i];
+                }
+                $bki .= "\n )\n";
+                undef(@attr);
+                undef(@types);
+                $reln_open = 1;
+                $inside = 0;
+                if ($bootstrap eq "")
+                {
+                    $bki .= "open $catalog\n";
+                }
+                next;
+            }
+
+            # inside catalog definition, so keep sucking up attributes
+            my @fields = split /\s+/,$line;
+            if ($fields[1] =~ /(.*)\[.*\]/)
+            { #Array attribute
+                push @attr, $1;
+                push @types, $fields[0] . '[]';
+            }
+            else
+            {
+                push @attr, $fields[1];
+                push @types, $fields[0];
+            }
+            next;
+        }
+    }
+    if ($reln_open == 1)
+    {
+        $bki .= "close $catalog\n";
+    }
+
+    open(O,">$prefix.bki") || die "Could not write $prefix.bki\n";
+    print O "# PostgreSQL $majorversion\n";
+    print O $bki;
+    close(O);
+    open(O,">$prefix.description") || die "Could not write $prefix.description\n";
+    print O $desc;
+    close(O);
+    open(O,">$prefix.shdescription") || die "Could not write $prefix.shdescription\n";
+    print O $shdesc;
+    close(O);
+}
+
+sub Usage
+{
+    print "Usage: genbki.pl <version> <prefix> <input1> [<input2> <input3>...]\n";
+    exit(1);
+}
+
+sub read_file
+{
+    my $filename = shift;
+    my $F;
+    my $t = $/;
+
+    undef $/;
+    open($F, $filename) || die "Could not open file $filename\n";
+    my $txt = <$F>;
+    close($F);
+    $/ = $t;
+
+    return $txt;
+}
+
+1;

src/tools/msvc/Install.pm

+package Install;
+
+use strict;
+use warnings;
+use Carp;
+use File::Basename;
+use File::Copy;
+
+use Exporter;
+our (@ISA,@EXPORT_OK);
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(Install);
+
+sub Install
+{
+    $| = 1;
+
+    my $target = shift;
+
+    chdir("../../..") if (-f "../../../configure");
+    my $conf = "";
+    if (-d "debug")
+    {
+        $conf = "debug";
+    }
+    if (-d "release")
+    {
+        $conf = "release";
+    }
+    die "Could not find debug or release binaries" if ($conf eq "");
+    print "Installing for $conf\n";
+
+    EnsureDirectories($target, 'bin','lib','share','share/timezonesets');
+
+    CopySolutionOutput($conf, $target);
+    copy($target . '/lib/libpq.dll', $target . '/bin/libpq.dll');
+    CopySetOfFiles('config files', "*.sample", $target . '/share/');
+    CopySetOfFiles('timezone names', 'src\timezone\tznames\*.txt',$target . '/share/timezonesets/');
+    CopyFiles(
+        'timezone sets',
+        $target . '/share/timezonesets/',
+        'src/timezone/tznames/', 'Default','Australia','India'
+    );
+    CopySetOfFiles('BKI files', "src\\backend\\catalog\\postgres.*", $target .'/share/');
+    CopySetOfFiles('SQL files', "src\\backend\\catalog\\*.sql", $target . '/share/');
+    CopyFiles(
+        'Information schema data',
+        $target . '/share/',
+        'src/backend/catalog/', 'sql_features.txt'
+    );
+    GenerateConversionScript($target);
+    GenerateTimezoneFiles($target,$conf);
+}
+
+sub EnsureDirectories
+{
+    my $target = shift;
+    mkdir $target unless -d ($target);
+    while (my $d = shift)
+    {
+        mkdir $target . '/' . $d unless -d ($target . '/' . $d);
+    }
+}
+
+sub CopyFiles
+{
+    my $what = shift;
+    my $target = shift;
+    my $basedir = shift;
+
+    print "Copying $what";
+    while (my $f = shift)
+    {
+        print ".";
+        $f = $basedir . $f;
+        die "No file $f\n" if (!-f $f);
+        copy($f, $target . basename($f))
+          || croak "Could not copy $f to $target". basename($f). " to $target". basename($f) . "\n";
+    }
+    print "\n";
+}
+
+sub CopySetOfFiles
+{
+    my $what = shift;
+    my $spec = shift;
+    my $target = shift;
+    my $D;
+
+    print "Copying $what";
+    open($D, "dir /b /s $spec |") || croak "Could not list $spec\n";
+    while (<$D>)
+    {
+        chomp;
+        next if /regress/; # Skip temporary install in regression subdir
+        my $tgt = $target . basename($_);
+        print ".";
+        copy($_, $tgt) || croak "Could not copy $_: $!\n";
+    }
+    close($D);
+    print "\n";
+}
+
+sub CopySolutionOutput
+{
+    my $conf = shift;
+    my $target = shift;
+    my $rem = qr{Project\("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}"\) = "([^"]+)"};
+
+    my $sln = read_file("pgsql.sln") || croak "Could not open pgsql.sln\n";
+    print "Copying build output files...";
+    while ($sln =~ $rem)
+    {
+        my $pf = $1;
+        my $dir;
+        my $ext;
+
+        $sln =~ s/$rem//;
+
+        my $proj = read_file("$pf.vcproj") || croak "Could not open $pf.vcproj\n";
+        if ($proj !~ qr{ConfigurationType="([^"]+)"})
+        {
+            croak "Could not parse $pf.vcproj\n";
+        }
+        if ($1 == 1)
+        {
+            $dir = "bin";
+            $ext = "exe";
+        }
+        elsif ($1 == 2)
+        {
+            $dir = "lib";
+            $ext = "dll";
+        }
+        else
+        {
+
+            # Static lib, such as libpgport, only used internally during build, don't install
+            next;
+        }
+        copy("$conf\\$pf\\$pf.$ext","$target\\$dir\\$pf.$ext") || croak "Could not copy $pf.$ext\n";
+        print ".";
+    }
+    print "\n";
+}
+
+sub GenerateConversionScript
+{
+    my $target = shift;
+    my $sql = "";
+    my $F;
+
+    print "Generating conversion proc script...";
+    my $mf = read_file('src/backend/utils/mb/conversion_procs/Makefile');
+    $mf =~ s{\\\s*[\r\n]+}{}mg;
+    $mf =~ /^CONVERSIONS\s*=\s*(.*)$/m
+      || die "Could not find CONVERSIONS line in conversions Makefile\n";
+    my @pieces = split /\s+/,$1;
+    while ($#pieces > 0)
+    {
+        my $name = shift @pieces;
+        my $se = shift @pieces;
+        my $de = shift @pieces;
+        my $func = shift @pieces;
+        my $obj = shift @pieces;
+        $sql .= "-- $se --> $de\n";
+        $sql .=
+"CREATE OR REPLACE FUNCTION $func (INTEGER, INTEGER, CSTRING, INTERNAL, INTEGER) RETURNS VOID AS '\$libdir/$obj', '$func' LANGUAGE C STRICT;\n";
+        $sql .= "DROP CONVERSION pg_catalog.$name;\n";
+        $sql .= "CREATE DEFAULT CONVERSION pg_catalog.$name FOR '$se' TO '$de' FROM $func;\n";
+    }
+    open($F,">$target/share/conversion_create.sql")
+      || die "Could not write to conversion_create.sql\n";
+    print $F $sql;
+    close($F);
+    print "\n";
+}
+
+sub GenerateTimezoneFiles
+{
+    my $target = shift;
+    my $conf = shift;
+    my $mf = read_file("src/timezone/Makefile");
+    $mf =~ s{\\\s*[\r\n]+}{}mg;
+    $mf =~ /^TZDATA\s*:?=\s*(.*)$/m || die "Could not find TZDATA row in timezone makefile\n";
+    my @tzfiles = split /\s+/,$1;
+    unshift @tzfiles,'';
+    print "Generating timezone files...";
+    system("$conf\\zic\\zic -d $target/share/timezone " . join(" src/timezone/data/", @tzfiles));
+    print "\n";
+}
+
+sub read_file
+{
+    my $filename = shift;
+    my $F;
+    my $t = $/;
+
+    undef $/;
+    open($F, $filename) || die "Could not open file $filename\n";
+    my $txt = <$F>;
+    close($F);
+    $/ = $t;
+
+    return $txt;
+}
+
+1;

src/tools/msvc/README

@@ -8,5 +8,5 @@ Notes about code indention
 --------------------------
 If the perl code is modified, use perltidy on it since pgindent won't
 touch perl code. Use the following commandline:
-perltidy -b -bl -nsfs -naws -l=100 *.pl *.pm
+perltidy -b -bl -nsfs -naws -l=100 -ole=unix *.pl *.pm
 

src/tools/msvc/Solution.pm

@@ -3,6 +3,8 @@ use Carp;
 use strict;
 use warnings;
 
+use Genbki;
+
 sub new
 {
     my $junk = shift;
@@ -266,8 +268,11 @@ EOF
         if (IsNewer('src/backend/catalog/postgres.bki', "src/include/catalog/$bki"))
         {
             print "Generating postgres.bki...\n";
-            system("perl src/tools/msvc/genbki.pl $self->{majorver} src/backend/catalog/postgres "
-                  . join(' src/include/catalog/',@allbki));
+            Genbki::genbki(
+                $self->{majorver},
+                "src/backend/catalog/postgres",
+                split(/ /,join(' src/include/catalog/',@allbki))
+            );
             last;
         }
     }

src/tools/msvc/install.pl

 use strict;
 use warnings;
-use Carp;
-use File::Basename;
-use File::Copy;
 
-$| = 1;
+use Install qw(Install);
 
 my $target = shift || Usage();
-
-chdir("../../..") if (-f "../../../configure");
-my $conf = "";
-if (-d "debug")
-{
-    $conf = "debug";
-}
-if (-d "release")
-{
-    $conf = "release";
-}
-die "Could not find debug or release binaries" if ($conf eq "");
-print "Installing for $conf\n";
-
-EnsureDirectories('bin','lib','share','share/timezonesets');
-
-CopySolutionOutput($conf, $target);
-copy($target . '/lib/libpq.dll', $target . '/bin/libpq.dll');
-CopySetOfFiles('config files', "*.sample", $target . '/share/');
-CopySetOfFiles('timezone names', 'src\timezone\tznames\*.txt', $target . '/share/timezonesets/');
-CopyFiles(
-    'timezone sets',
-    $target . '/share/timezonesets/',
-    'src/timezone/tznames/', 'Default','Australia','India'
-);
-CopySetOfFiles('BKI files', "src\\backend\\catalog\\postgres.*", $target .'/share/');
-CopySetOfFiles('SQL files', "src\\backend\\catalog\\*.sql", $target . '/share/');
-CopyFiles(
-    'Information schema data',
-    $target . '/share/',
-    'src/backend/catalog/', 'sql_features.txt'
-);
-GenerateConversionScript();
-GenerateTimezoneFiles();
+Install($target);
 
 sub Usage
 {
     print "Usage: install.pl <targetdir>\n";
     exit(1);
 }
-
-sub EnsureDirectories
-{
-    mkdir $target unless -d ($target);
-    while (my $d = shift)
-    {
-        mkdir $target . '/' . $d unless -d ($target . '/' . $d);
-    }
-}
-
-sub CopyFiles
-{
-    my $what = shift;
-    my $target = shift;
-    my $basedir = shift;
-
-    print "Copying $what";
-    while (my $f = shift)
-    {
-        print ".";
-        $f = $basedir . $f;
-        die "No file $f\n" if (!-f $f);
-        copy($f, $target . basename($f))
-          || croak "Could not copy $f to $target"
-          . basename($f)
-          . " to $target"
-          . basename($f) . "\n";
-    }
-    print "\n";
-}
-
-sub CopySetOfFiles
-{
-    my $what = shift;
-    my $spec = shift;
-    my $target = shift;
-    my $D;
-
-    print "Copying $what";
-    open($D, "dir /b /s $spec |") || croak "Could not list $spec\n";
-    while (<$D>)
-    {
-        chomp;
-        next if /regress/; # Skip temporary install in regression subdir
-        my $tgt = $target . basename($_);
-        print ".";
-        copy($_, $tgt) || croak "Could not copy $_: $!\n";
-    }
-    close($D);
-    print "\n";
-}
-
-sub CopySolutionOutput
-{
-    my $conf = shift;
-    my $target = shift;
-    my $rem = qr{Project\("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}"\) = "([^"]+)"};
-
-    my $sln = read_file("pgsql.sln") || croak "Could not open pgsql.sln\n";
-    print "Copying build output files...";
-    while ($sln =~ $rem)
-    {
-        my $pf = $1;
-        my $dir;
-        my $ext;
-
-        $sln =~ s/$rem//;
-
-        my $proj = read_file("$pf.vcproj") || croak "Could not open $pf.vcproj\n";
-        if ($proj !~ qr{ConfigurationType="([^"]+)"})
-        {
-            croak "Could not parse $pf.vcproj\n";
-        }
-        if ($1 == 1)
-        {
-            $dir = "bin";
-            $ext = "exe";
-        }
-        elsif ($1 == 2)
-        {
-            $dir = "lib";
-            $ext = "dll";
-        }
-        else
-        {
-
-            # Static lib, such as libpgport, only used internally during build, don't install
-            next;
-        }
-        copy("$conf\\$pf\\$pf.$ext","$target\\$dir\\$pf.$ext") || croak "Could not copy $pf.$ext\n";
-        print ".";
-    }
-    print "\n";
-}
-
-sub GenerateConversionScript
-{
-    my $sql = "";
-    my $F;
-
-    print "Generating conversion proc script...";
-    my $mf = read_file('src/backend/utils/mb/conversion_procs/Makefile');
-    $mf =~ s{\\\s*[\r\n]+}{}mg;
-    $mf =~ /^CONVERSIONS\s*=\s*(.*)$/m
-      || die "Could not find CONVERSIONS line in conversions Makefile\n";
-    my @pieces = split /\s+/,$1;
-    while ($#pieces > 0)
-    {
-        my $name = shift @pieces;
-        my $se = shift @pieces;
-        my $de = shift @pieces;
-        my $func = shift @pieces;
-        my $obj = shift @pieces;
-        $sql .= "-- $se --> $de\n";
-        $sql .=
-"CREATE OR REPLACE FUNCTION $func (INTEGER, INTEGER, CSTRING, INTERNAL, INTEGER) RETURNS VOID AS '\$libdir/$obj', '$func' LANGUAGE C STRICT;\n";
-        $sql .= "DROP CONVERSION pg_catalog.$name;\n";
-        $sql .= "CREATE DEFAULT CONVERSION pg_catalog.$name FOR '$se' TO '$de' FROM $func;\n";
-    }
-    open($F,">$target/share/conversion_create.sql")
-      || die "Could not write to conversion_create.sql\n";
-    print $F $sql;
-    close($F);
-    print "\n";
-}
-
-sub GenerateTimezoneFiles
-{
-    my $mf = read_file("src/timezone/Makefile");
-    $mf =~ s{\\\s*[\r\n]+}{}mg;
-    $mf =~ /^TZDATA\s*:?=\s*(.*)$/m || die "Could not find TZDATA row in timezone makefile\n";
-    my @tzfiles = split /\s+/,$1;
-    unshift @tzfiles,'';
-    print "Generating timezone files...";
-    system("$conf\\zic\\zic -d $target/share/timezone " . join(" src/timezone/data/", @tzfiles));
-    print "\n";
-}
-
-sub read_file
-{
-    my $filename = shift;
-    my $F;
-    my $t = $/;
-
-    undef $/;
-    open($F, $filename) || die "Could not open file $filename\n";
-    my $txt = <$F>;
-    close($F);
-    $/ = $t;
-
-    return $txt;
-}
-

src/tools/msvc/vcregress.bat

@@ -24,6 +24,8 @@ SET SCHEDULE=parallel
 SET TEMPPORT=54321
 IF NOT "%2"=="" SET SCHEDULE=%2
 
+SET PERL5LIB=..\..\tools\msvc
+
 if "%what%"=="INSTALLCHECK" ..\..\..\%CONFIG%\pg_regress\pg_regress --psqldir=..\..\..\%CONFIG%\psql --schedule=%SCHEDULE%_schedule --multibyte=SQL_ASCII --load-language=plpgsql --no-locale
 if "%what%"=="CHECK" ..\..\..\%CONFIG%\pg_regress\pg_regress --psqldir=..\..\..\%CONFIG%\psql --schedule=%SCHEDULE%_schedule --multibyte=SQL_ASCII --load-language=plpgsql --no-locale --temp-install=./tmp_check --top-builddir=%TOPDIR% --temp-port=%TEMPPORT%