src/tools/msvc/Genbki.pm

   1 #!/usr/bin/perl
   2 #-------------------------------------------------------------------------
   3 #
   4 # Genbki.pm --
   5 #    perl script which generates .bki files from specially formatted .h
   6 #    files.  These .bki files are used to initialize the postgres template
   7 #    database.
   8 #
   9 # Portions Copyright (c) 1996-2009, PostgreSQL Global Development Group
  10 # Portions Copyright (c) 1994, Regents of the University of California
  11 #
  12 #
  13 # IDENTIFICATION
  14 #    $PostgreSQL$
  15 #
  16 #-------------------------------------------------------------------------
  17
  18 package Genbki;
  19
  20 use strict;
  21 use warnings;
  22
  23 use Exporter;
  24 our (@ISA, @EXPORT_OK);
  25 @ISA = qw(Exporter);
  26 @EXPORT_OK = qw(genbki);
  27
  28 sub genbki
  29 {
  30     my $version = shift;
  31     my $prefix = shift;
  32
  33     $version =~ /^(\d+\.\d+)/ || die "Bad format verison $version\n";
  34     my $majorversion = $1;
  35
  36     my $pgauthid = read_file("src/include/catalog/pg_authid.h");
  37     $pgauthid =~ /^#define\s+BOOTSTRAP_SUPERUSERID\s+(\d+)$/mg
  38       || die "Could not read BOOTSTRAUP_SUPERUSERID from pg_authid.h\n";
  39     my $bootstrapsuperuserid = $1;
  40
  41     my $pgnamespace = read_file("src/include/catalog/pg_namespace.h");
  42     $pgnamespace =~ /^#define\s+PG_CATALOG_NAMESPACE\s+(\d+)$/mg
  43       || die "Could not read PG_CATALOG_NAMESPACE from pg_namespace.h\n";
  44     my $pgcatalognamespace = $1;
  45
  46     my $indata = "";
  47
  48     while (@_)
  49     {
  50         my $f = shift;
  51         next unless $f;
  52         $indata .= read_file($f);
  53         $indata .= "\n";
  54     }
  55
  56     # Strip C comments, from perl FAQ 4.27
  57     $indata =~ s{/\*.*?\*/}{}gs;
  58
  59     $indata =~ s{;\s*$}{}gm;
  60     $indata =~ s{^\s+}{}gm;
  61     $indata =~ s{^Oid}{oid}gm;
  62     $indata =~ s{\(Oid}{(oid}gm;
  63     $indata =~ s{^NameData}{name}gm;
  64     $indata =~ s{\(NameData}{(name}g;
  65     $indata =~ s{^TransactionId}{xid}gm;
  66     $indata =~ s{\(TransactionId}{(xid}g;
  67     $indata =~ s{PGUID}{$bootstrapsuperuserid}g;
  68     $indata =~ s{PGNSP}{$pgcatalognamespace}g;
  69
  70     #print $indata;
  71
  72     my $bki = "";
  73     my $desc = "";
  74     my $shdesc = "";
  75
  76     my $oid = 0;
  77     my $catalog = 0;
  78     my $reln_open = 0;
  79     my $bootstrap = "";
  80     my $shared_relation = "";
  81     my $without_oids = "";
  82     my $nc = 0;
  83     my $inside = 0;
  84     my @attr;
  85     my @types;
  86
  87     foreach my $line (split /\n/, $indata)
  88     {
  89         if ($line =~ /^DATA\((.*)\)$/m)
  90         {
  91             my $data = $1;
  92             my @fields = split /\s+/,$data;
  93             if ($#fields >=4 && $fields[0] eq "insert" && $fields[1] eq "OID" && $fields[2] eq "=")
  94             {
  95                 $oid = $fields[3];
  96             }
  97             else
  98             {
  99                 $oid = 0;
 100             }
 101             $data =~ s/\s{2,}/ /g;
 102             $bki .= $data . "\n";
 103         }
 104         elsif ($line =~ /^DESCR\("(.*)"\)$/m)
 105         {
 106             if ($oid != 0)
 107             {
 108                 $desc .= sprintf("%d\t%s\t0\t%s\n", $oid, $catalog, $1);
 109             }
 110         }
 111         elsif ($line =~ /^SHDESCR\("(.*)"\)$/m)
 112         {
 113             if ($oid != 0)
 114             {
 115                 $shdesc .= sprintf("%d\t%s\t%s\n", $oid, $catalog, $1);
 116             }
 117         }
 118         elsif ($line =~ /^DECLARE_(UNIQUE_)?INDEX\((.*)\)$/m)
 119         {
 120             if ($reln_open)
 121             {
 122                 $bki .= "close $catalog\n";
 123                 $reln_open = 0;
 124             }
 125             my $u = $1?" unique":"";
 126             my @fields = split /,/,$2,3;
 127             $fields[2] =~ s/\s{2,}/ /g;
 128             $bki .= "declare$u index $fields[0] $fields[1] $fields[2]\n";
 129         }
 130         elsif ($line =~ /^DECLARE_TOAST\((.*)\)$/m)
 131         {
 132             if ($reln_open)
 133             {
 134                 $bki .= "close $catalog\n";
 135                 $reln_open = 0;
 136             }
 137             my @fields = split /,/,$1;
 138             $bki .= "declare toast $fields[1] $fields[2] on $fields[0]\n";
 139         }
 140         elsif ($line =~ /^BUILD_INDICES/)
 141         {
 142             $bki .= "build indices\n";
 143         }
 144         elsif ($line =~ /^CATALOG\((.*)\)(.*)$/m)
 145         {
 146             if ($reln_open)
 147             {
 148                 $bki .= "close $catalog\n";
 149                 $reln_open = 0;
 150             }
 151             my $rest = $2;
 152             my @fields = split /,/,$1;
 153             $catalog = $fields[0];
 154             $oid = $fields[1];
 155             $bootstrap=$shared_relation=$without_oids="";
 156             if ($rest =~ /BKI_BOOTSTRAP/)
 157             {
 158                 $bootstrap = "bootstrap ";
 159             }
 160             if ($rest =~ /BKI_SHARED_RELATION/)
 161             {
 162                 $shared_relation = "shared_relation ";
 163             }
 164             if ($rest =~ /BKI_WITHOUT_OIDS/)
 165             {
 166                 $without_oids = "without_oids ";
 167             }
 168             $nc++;
 169             $inside = 1;
 170             next;
 171         }
 172         if ($inside==1)
 173         {
 174             next if ($line =~ /{/);
 175             if ($line =~ /}/)
 176             {
 177
 178                 # Last line
 179                 $bki .= "create $bootstrap$shared_relation$without_oids$catalog $oid\n (\n";
 180                 my $first = 1;
 181                 for (my $i = 0; $i <= $#attr; $i++)
 182                 {
 183                     if ($first == 1)
 184                     {
 185                         $first = 0;
 186                     }
 187                     else
 188                     {
 189                         $bki .= ",\n";
 190                     }
 191                     $bki .= " " . $attr[$i] . " = " . $types[$i];
 192                 }
 193                 $bki .= "\n )\n";
 194                 undef(@attr);
 195                 undef(@types);
 196                 $reln_open = 1;
 197                 $inside = 0;
 198                 if ($bootstrap eq "")
 199                 {
 200                     $bki .= "open $catalog\n";
 201                 }
 202                 next;
 203             }
 204
 205             # inside catalog definition, so keep sucking up attributes
 206             my @fields = split /\s+/,$line;
 207             if ($fields[1] =~ /(.*)\[.*\]/)
 208             { #Array attribute
 209                 push @attr, $1;
 210                 push @types, $fields[0] . '[]';
 211             }
 212             else
 213             {
 214                 push @attr, $fields[1];
 215                 push @types, $fields[0];
 216             }
 217             next;
 218         }
 219     }
 220     if ($reln_open == 1)
 221     {
 222         $bki .= "close $catalog\n";
 223     }
 224
 225     open(O,">$prefix.bki") || die "Could not write $prefix.bki\n";
 226     print O "# PostgreSQL $majorversion\n";
 227     print O $bki;
 228     close(O);
 229     open(O,">$prefix.description") || die "Could not write $prefix.description\n";
 230     print O $desc;
 231     close(O);
 232     open(O,">$prefix.shdescription") || die "Could not write $prefix.shdescription\n";
 233     print O $shdesc;
 234     close(O);
 235 }
 236
 237 sub read_file
 238 {
 239     my $filename = shift;
 240     my $F;
 241     my $t = $/;
 242
 243     undef $/;
 244     open($F, $filename) || die "Could not open file $filename\n";
 245     my $txt = <$F>;
 246     close($F);
 247     $/ = $t;
 248
 249     return $txt;
 250 }
 251
 252 1;