granicus.if.org Git - postgresql/blob - src/backend/catalog/Catalog.pm

   1 #----------------------------------------------------------------------
   2 #
   3 # Catalog.pm
   4 #    Perl module that extracts info from catalog headers into Perl
   5 #    data structures
   6 #
   7 # Portions Copyright (c) 1996-2013, PostgreSQL Global Development Group
   8 # Portions Copyright (c) 1994, Regents of the University of California
   9 #
  10 # src/backend/catalog/Catalog.pm
  11 #
  12 #----------------------------------------------------------------------
  13
  14 package Catalog;
  15
  16 use strict;
  17 use warnings;
  18
  19 require Exporter;
  20 our @ISA       = qw(Exporter);
  21 our @EXPORT    = ();
  22 our @EXPORT_OK = qw(Catalogs RenameTempFile);
  23
  24 # Call this function with an array of names of header files to parse.
  25 # Returns a nested data structure describing the data in the headers.
  26 sub Catalogs
  27 {
  28         my (%catalogs, $catname, $declaring_attributes, $most_recent);
  29         $catalogs{names} = [];
  30
  31         # There are a few types which are given one name in the C source, but a
  32         # different name at the SQL level.  These are enumerated here.
  33         my %RENAME_ATTTYPE = (
  34                 'int16'         => 'int2',
  35                 'int32'         => 'int4',
  36                 'Oid'           => 'oid',
  37                 'NameData'      => 'name',
  38                 'TransactionId' => 'xid');
  39
  40         foreach my $input_file (@_)
  41         {
  42                 my %catalog;
  43                 $catalog{columns} = [];
  44                 $catalog{data}    = [];
  45
  46                 open(INPUT_FILE, '<', $input_file) || die "$input_file: $!";
  47
  48                 # Scan the input file.
  49                 while (<INPUT_FILE>)
  50                 {
  51
  52                         # Strip C-style comments.
  53                         s;/\*(.|\n)*\*/;;g;
  54                         if (m;/\*;)
  55                         {
  56
  57                                 # handle multi-line comments properly.
  58                                 my $next_line = <INPUT_FILE>;
  59                                 die "$input_file: ends within C-style comment\n"
  60                                   if !defined $next_line;
  61                                 $_ .= $next_line;
  62                                 redo;
  63                         }
  64
  65                         # Strip useless whitespace and trailing semicolons.
  66                         chomp;
  67                         s/^\s+//;
  68                         s/;\s*$//;
  69                         s/\s+/ /g;
  70
  71                         # Push the data into the appropriate data structure.
  72                         if (/^DATA\(insert(\s+OID\s+=\s+(\d+))?\s+\(\s*(.*)\s*\)\s*\)$/)
  73                         {
  74                                 push @{ $catalog{data} }, { oid => $2, bki_values => $3 };
  75                         }
  76                         elsif (/^DESCR\(\"(.*)\"\)$/)
  77                         {
  78                                 $most_recent = $catalog{data}->[-1];
  79
  80                                 # this tests if most recent line is not a DATA() statement
  81                                 if (ref $most_recent ne 'HASH')
  82                                 {
  83                                         die "DESCR() does not apply to any catalog ($input_file)";
  84                                 }
  85                                 if (!defined $most_recent->{oid})
  86                                 {
  87                                         die "DESCR() does not apply to any oid ($input_file)";
  88                                 }
  89                                 elsif ($1 ne '')
  90                                 {
  91                                         $most_recent->{descr} = $1;
  92                                 }
  93                         }
  94                         elsif (/^SHDESCR\(\"(.*)\"\)$/)
  95                         {
  96                                 $most_recent = $catalog{data}->[-1];
  97
  98                                 # this tests if most recent line is not a DATA() statement
  99                                 if (ref $most_recent ne 'HASH')
 100                                 {
 101                                         die
 102                                           "SHDESCR() does not apply to any catalog ($input_file)";
 103                                 }
 104                                 if (!defined $most_recent->{oid})
 105                                 {
 106                                         die "SHDESCR() does not apply to any oid ($input_file)";
 107                                 }
 108                                 elsif ($1 ne '')
 109                                 {
 110                                         $most_recent->{shdescr} = $1;
 111                                 }
 112                         }
 113                         elsif (/^DECLARE_TOAST\(\s*(\w+),\s*(\d+),\s*(\d+)\)/)
 114                         {
 115                                 $catname = 'toasting';
 116                                 my ($toast_name, $toast_oid, $index_oid) = ($1, $2, $3);
 117                                 push @{ $catalog{data} },
 118                                   "declare toast $toast_oid $index_oid on $toast_name\n";
 119                         }
 120                         elsif (/^DECLARE_(UNIQUE_)?INDEX\(\s*(\w+),\s*(\d+),\s*(.+)\)/)
 121                         {
 122                                 $catname = 'indexing';
 123                                 my ($is_unique, $index_name, $index_oid, $using) =
 124                                   ($1, $2, $3, $4);
 125                                 push @{ $catalog{data} },
 126                                   sprintf(
 127                                         "declare %sindex %s %s %s\n",
 128                                         $is_unique ? 'unique ' : '',
 129                                         $index_name, $index_oid, $using);
 130                         }
 131                         elsif (/^BUILD_INDICES/)
 132                         {
 133                                 push @{ $catalog{data} }, "build indices\n";
 134                         }
 135                         elsif (/^CATALOG\(([^,]*),(\d+)\)/)
 136                         {
 137                                 $catname = $1;
 138                                 $catalog{relation_oid} = $2;
 139
 140                                 # Store pg_* catalog names in the same order we receive them
 141                                 push @{ $catalogs{names} }, $catname;
 142
 143                                 $catalog{bootstrap} = /BKI_BOOTSTRAP/ ? ' bootstrap' : '';
 144                                 $catalog{shared_relation} =
 145                                   /BKI_SHARED_RELATION/ ? ' shared_relation' : '';
 146                                 $catalog{without_oids} =
 147                                   /BKI_WITHOUT_OIDS/ ? ' without_oids' : '';
 148                                 $catalog{rowtype_oid} =
 149                                   /BKI_ROWTYPE_OID\((\d+)\)/ ? " rowtype_oid $1" : '';
 150                                 $catalog{schema_macro} = /BKI_SCHEMA_MACRO/ ? 'True' : '';
 151                                 $declaring_attributes = 1;
 152                         }
 153                         elsif ($declaring_attributes)
 154                         {
 155                                 next if (/^{|^$/);
 156                                 next if (/^#/);
 157                                 if (/^}/)
 158                                 {
 159                                         undef $declaring_attributes;
 160                                 }
 161                                 else
 162                                 {
 163                                         my ($atttype, $attname) = split /\s+/, $_;
 164                                         die "parse error ($input_file)" unless $attname;
 165                                         if (exists $RENAME_ATTTYPE{$atttype})
 166                                         {
 167                                                 $atttype = $RENAME_ATTTYPE{$atttype};
 168                                         }
 169                                         if ($attname =~ /(.*)\[.*\]/)    # array attribute
 170                                         {
 171                                                 $attname = $1;
 172                                                 $atttype .= '[]';            # variable-length only
 173                                         }
 174                                         push @{ $catalog{columns} }, { $attname => $atttype };
 175                                 }
 176                         }
 177                 }
 178                 $catalogs{$catname} = \%catalog;
 179                 close INPUT_FILE;
 180         }
 181         return \%catalogs;
 182 }
 183
 184 # Rename temporary files to final names.
 185 # Call this function with the final file name and the .tmp extension
 186 # Note: recommended extension is ".tmp$$", so that parallel make steps
 187 # can't use the same temp files
 188 sub RenameTempFile
 189 {
 190         my $final_name = shift;
 191         my $extension  = shift;
 192         my $temp_name  = $final_name . $extension;
 193         print "Writing $final_name\n";
 194         rename($temp_name, $final_name) || die "rename: $temp_name: $!";
 195 }
 196
 197 1;