Skip to content

P
Postgres FD Implementation
Commit 042d9ffc authored by Bruce Momjian's avatar Bruce Momjian
Browse files
Options

Run newly-configured perltidy script on Perl files. 

Run on HEAD and 9.2.
parent d7c73484
Hide whitespace changes
Inline Side-by-side
Showing with 3297 additions and 2637 deletions
contrib/intarray/bench/bench.pl
View file @ 042d9ffc
#!/usr/bin/perl #!/usr/bin/perl
use strict; use strict;
# make sure we are in a sane environment. # make sure we are in a sane environment.
use DBI(); use DBI();
use DBD::Pg(); use DBD::Pg();
...@@ -10,7 +11,8 @@ use Getopt::Std; ...@@ -10,7 +11,8 @@ use Getopt::Std;
my %opt; my %opt;
getopts('d:b:s:veorauc', \%opt); getopts('d:b:s:veorauc', \%opt);
if ( !( scalar %opt && defined $opt{s} ) ) { if (!(scalar %opt && defined $opt{s}))
{
print <<EOT; print <<EOT;
Usage: Usage:
$0 -d DATABASE -s SECTIONS [-b NUMBER] [-v] [-e] [-o] [-r] [-a] [-u] $0 -d DATABASE -s SECTIONS [-b NUMBER] [-v] [-e] [-o] [-r] [-a] [-u]
...@@ -30,27 +32,37 @@ EOT ...@@ -30,27 +32,37 @@ EOT
} }
$opt{d} ||= '_int4'; $opt{d} ||= '_int4';
my $dbi=DBI->connect('DBI:Pg:dbname='.$opt{d}); my $dbi = DBI->connect('DBI:Pg:dbname=' . $opt{d});
my %table; my %table;
my @where; my @where;
$table{message}=1; $table{message} = 1;
if ( $opt{a} ) { if ($opt{a})
if ( $opt{r} ) { {
if ($opt{r})
{
push @where, "message.sections @ '{$opt{s}}'"; push @where, "message.sections @ '{$opt{s}}'";
} else { }
foreach my $sid ( split(/[,\s]+/, $opt{s} )) { else
{
foreach my $sid (split(/[,\s]+/, $opt{s}))
{
push @where, "message.mid = msp$sid.mid"; push @where, "message.mid = msp$sid.mid";
push @where, "msp$sid.sid = $sid"; push @where, "msp$sid.sid = $sid";
$table{"message_section_map msp$sid"}=1; $table{"message_section_map msp$sid"} = 1;
} }
} }
} else { }
if ( $opt{r} ) { else
{
if ($opt{r})
{
push @where, "message.sections && '{$opt{s}}'"; push @where, "message.sections && '{$opt{s}}'";
} else { }
else
{
$table{message_section_map} = 1; $table{message_section_map} = 1;
push @where, "message.mid = message_section_map.mid"; push @where, "message.mid = message_section_map.mid";
push @where, "message_section_map.sid in ($opt{s})"; push @where, "message_section_map.sid in ($opt{s})";
...@@ -58,48 +70,66 @@ if ( $opt{a} ) { ...@@ -58,48 +70,66 @@ if ( $opt{a} ) {
} }
my $outf; my $outf;
if ( $opt{c} ) { if ($opt{c})
$outf = ( $opt{u} ) ? 'count( distinct message.mid )' : 'count( message.mid )'; {
} else { $outf =
$outf = ( $opt{u} ) ? 'distinct( message.mid )' : 'message.mid'; ($opt{u}) ? 'count( distinct message.mid )' : 'count( message.mid )';
}
else
{
$outf = ($opt{u}) ? 'distinct( message.mid )' : 'message.mid';
} }
my $sql = "select $outf from ".join(', ', keys %table)." where ".join(' AND ', @where).';'; my $sql =
"select $outf from "
. join(', ', keys %table)
. " where "
. join(' AND ', @where) . ';';
if ( $opt{v} ) { if ($opt{v})
{
print "$sql\n"; print "$sql\n";
} }
if ( $opt{e} ) { if ($opt{e})
{
$dbi->do("explain $sql"); $dbi->do("explain $sql");
} }
my $t0 = [gettimeofday]; my $t0 = [gettimeofday];
my $count=0; my $count = 0;
my $b=$opt{b}; my $b = $opt{b};
$b||=1; $b ||= 1;
my @a; my @a;
foreach ( 1..$b ) { foreach (1 .. $b)
@a=exec_sql($dbi,$sql); {
$count=$#a; @a = exec_sql($dbi, $sql);
$count = $#a;
} }
my $elapsed = tv_interval ( $t0, [gettimeofday]); my $elapsed = tv_interval($t0, [gettimeofday]);
if ( $opt{o} ) { if ($opt{o})
foreach ( @a ) { {
foreach (@a)
{
print "$_->{mid}\t$_->{sections}\n"; print "$_->{mid}\t$_->{sections}\n";
} }
} }
print sprintf("total: %.02f sec; number: %d; for one: %.03f sec; found %d docs\n", $elapsed, $b, $elapsed/$b, $count+1 ); print sprintf(
$dbi -> disconnect; "total: %.02f sec; number: %d; for one: %.03f sec; found %d docs\n",
$elapsed, $b, $elapsed / $b,
$count + 1);
$dbi->disconnect;
sub exec_sql { sub exec_sql
my ($dbi, $sql, @keys) = @_; {
my $sth=$dbi->prepare($sql) || die; my ($dbi, $sql, @keys) = @_;
$sth->execute( @keys ) || die; my $sth = $dbi->prepare($sql) || die;
my $r; $sth->execute(@keys) || die;
my @row; my $r;
while ( defined ( $r=$sth->fetchrow_hashref ) ) { my @row;
push @row, $r; while (defined($r = $sth->fetchrow_hashref))
} {
$sth->finish; push @row, $r;
return @row; }
$sth->finish;
return @row;
} }
contrib/intarray/bench/create_test.pl
View file @ 042d9ffc
...@@ -15,28 +15,38 @@ create table message_section_map ( ...@@ -15,28 +15,38 @@ create table message_section_map (
EOT EOT
open(MSG,">message.tmp") || die; open(MSG, ">message.tmp") || die;
open(MAP,">message_section_map.tmp") || die; open(MAP, ">message_section_map.tmp") || die;
srand(1);
srand( 1 );
#foreach my $i ( 1..1778 ) { #foreach my $i ( 1..1778 ) {
#foreach my $i ( 1..3443 ) { #foreach my $i ( 1..3443 ) {
#foreach my $i ( 1..5000 ) { #foreach my $i ( 1..5000 ) {
#foreach my $i ( 1..29362 ) { #foreach my $i ( 1..29362 ) {
#foreach my $i ( 1..33331 ) { #foreach my $i ( 1..33331 ) {
#foreach my $i ( 1..83268 ) { #foreach my $i ( 1..83268 ) {
foreach my $i ( 1..200000 ) { foreach my $i (1 .. 200000)
{
my @sect; my @sect;
if ( rand() < 0.7 ) { if (rand() < 0.7)
$sect[0] = int( (rand()**4)*100 ); {
} else { $sect[0] = int((rand()**4) * 100);
}
else
{
my %hash; my %hash;
@sect = grep { $hash{$_}++; $hash{$_} <= 1 } map { int( (rand()**4)*100) } 0..( int(rand()*5) ); @sect =
grep { $hash{$_}++; $hash{$_} <= 1 }
map { int((rand()**4) * 100) } 0 .. (int(rand() * 5));
} }
if ( $#sect < 0 || rand() < 0.1 ) { if ($#sect < 0 || rand() < 0.1)
{
print MSG "$i\t\\N\n"; print MSG "$i\t\\N\n";
} else { }
print MSG "$i\t{".join(',',@sect)."}\n"; else
{
print MSG "$i\t{" . join(',', @sect) . "}\n";
map { print MAP "$i\t$_\n" } @sect; map { print MAP "$i\t$_\n" } @sect;
} }
} }
...@@ -64,12 +74,13 @@ EOT ...@@ -64,12 +74,13 @@ EOT
unlink 'message.tmp', 'message_section_map.tmp'; unlink 'message.tmp', 'message_section_map.tmp';
sub copytable { sub copytable
{
my $t = shift; my $t = shift;
print "COPY $t from stdin;\n"; print "COPY $t from stdin;\n";
open( FFF, "$t.tmp") || die; open(FFF, "$t.tmp") || die;
while(<FFF>) { print; } while (<FFF>) { print; }
close FFF; close FFF;
print "\\.\n"; print "\\.\n";
} }
contrib/seg/seg-validate.pl
View file @ 042d9ffc
...@@ -2,12 +2,12 @@ ...@@ -2,12 +2,12 @@
$integer = '[+-]?[0-9]+'; $integer = '[+-]?[0-9]+';
$real = '[+-]?[0-9]+\.[0-9]+'; $real = '[+-]?[0-9]+\.[0-9]+';
$RANGE = '(\.\.)(\.)?'; $RANGE = '(\.\.)(\.)?';
$PLUMIN = q(\'\+\-\'); $PLUMIN = q(\'\+\-\');
$FLOAT = "(($integer)|($real))([eE]($integer))?"; $FLOAT = "(($integer)|($real))([eE]($integer))?";
$EXTENSION = '<|>|~'; $EXTENSION = '<|>|~';
$boundary = "($EXTENSION)?$FLOAT"; $boundary = "($EXTENSION)?$FLOAT";
$deviation = $FLOAT; $deviation = $FLOAT;
$rule_1 = $boundary . $PLUMIN . $deviation; $rule_1 = $boundary . $PLUMIN . $deviation;
...@@ -18,25 +18,33 @@ $rule_5 = $boundary; ...@@ -18,25 +18,33 @@ $rule_5 = $boundary;
print "$rule_5\n"; print "$rule_5\n";
while (<>) { while (<>)
# s/ +//g; {
if ( /^($rule_1)$/ ) {
print; # s/ +//g;
} if (/^($rule_1)$/)
elsif ( /^($rule_2)$/ ) { {
print; print;
} }
elsif ( /^($rule_3)$/ ) { elsif (/^($rule_2)$/)
print; {
} print;
elsif ( /^($rule_4)$/ ) { }
print; elsif (/^($rule_3)$/)
} {
elsif ( /^($rule_5)$/ ) { print;
print; }
} elsif (/^($rule_4)$/)
else { {
print STDERR "error in $_\n"; print;
} }
elsif (/^($rule_5)$/)
{
print;
}
else
{
print STDERR "error in $_\n";
}
} }
contrib/seg/sort-segments.pl
View file @ 042d9ffc
...@@ -2,19 +2,22 @@ ...@@ -2,19 +2,22 @@
# this script will sort any table with the segment data type in its last column # this script will sort any table with the segment data type in its last column
while (<>) { while (<>)
chomp; {
push @rows, $_; chomp;
push @rows, $_;
} }
foreach ( sort { foreach (
@ar = split("\t", $a); sort {
$valA = pop @ar; @ar = split("\t", $a);
$valA =~ s/[~<> ]+//g; $valA = pop @ar;
@ar = split("\t", $b); $valA =~ s/[~<> ]+//g;
$valB = pop @ar; @ar = split("\t", $b);
$valB =~ s/[~<> ]+//g; $valB = pop @ar;
$valA <=> $valB $valB =~ s/[~<> ]+//g;
} @rows ) { $valA <=> $valB
print "$_\n";; } @rows)
{
print "$_\n";
} }
doc/src/sgml/generate-errcodes-table.pl
View file @ 042d9ffc
...@@ -6,51 +6,54 @@ ...@@ -6,51 +6,54 @@
use warnings; use warnings;
use strict; use strict;
print "<!-- autogenerated from src/backend/utils/errcodes.txt, do not edit -->\n"; print
"<!-- autogenerated from src/backend/utils/errcodes.txt, do not edit -->\n";
open my $errcodes, $ARGV[0] or die; open my $errcodes, $ARGV[0] or die;
while (<$errcodes>) { while (<$errcodes>)
chomp; {
chomp;
# Skip comments # Skip comments
next if /^#/; next if /^#/;
next if /^\s*$/; next if /^\s*$/;
# Emit section headers # Emit section headers
if (/^Section:/) { if (/^Section:/)
{
# Remove the Section: string # Remove the Section: string
s/^Section: //; s/^Section: //;
# Escape dashes for SGML
s/-/&mdash;/;
# Wrap PostgreSQL in <productname/>
s/PostgreSQL/<productname>PostgreSQL<\/>/g;
print "\n\n"; # Escape dashes for SGML
print "<row>\n"; s/-/&mdash;/;
print "<entry spanname=\"span12\">";
print "<emphasis role=\"bold\">$_</></entry>\n"; # Wrap PostgreSQL in <productname/>
print "</row>\n"; s/PostgreSQL/<productname>PostgreSQL<\/>/g;
next; print "\n\n";
} print "<row>\n";
print "<entry spanname=\"span12\">";
print "<emphasis role=\"bold\">$_</></entry>\n";
print "</row>\n";
die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/; next;
}
(my $sqlstate, die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/;
my $type,
my $errcode_macro,
my $condition_name) = ($1, $2, $3, $4);
# Skip lines without PL/pgSQL condition names (my $sqlstate, my $type, my $errcode_macro, my $condition_name) =
next unless defined($condition_name); ($1, $2, $3, $4);
print "\n"; # Skip lines without PL/pgSQL condition names
print "<row>\n"; next unless defined($condition_name);
print "<entry><literal>$sqlstate</literal></entry>\n";
print "<entry><symbol>$condition_name</symbol></entry>\n"; print "\n";
print "</row>\n"; print "<row>\n";
print "<entry><literal>$sqlstate</literal></entry>\n";
print "<entry><symbol>$condition_name</symbol></entry>\n";
print "</row>\n";
} }
close $errcodes; close $errcodes;
doc/src/sgml/generate_history.pl
View file @ 042d9ffc
...@@ -25,34 +25,41 @@ process_file($infile); ...@@ -25,34 +25,41 @@ process_file($infile);
exit 0; exit 0;
sub process_file { sub process_file
my $filename = shift; {
my $filename = shift;
local *FILE; # need a local filehandle so we can recurse local *FILE; # need a local filehandle so we can recurse
my $f = $srcdir . '/' . $filename; my $f = $srcdir . '/' . $filename;
open(FILE, $f) || die "could not read $f: $!\n"; open(FILE, $f) || die "could not read $f: $!\n";
while (<FILE>) { while (<FILE>)
# Recursively expand sub-files of the release notes {
if (m/^&(release-.*);$/) {
process_file($1 . ".sgml");
next;
}
# Remove <link ...> tags, which might span multiple lines # Recursively expand sub-files of the release notes
while (m/<link/) { if (m/^&(release-.*);$/)
if (s/<link\s+linkend[^>]*>//) { {
next; process_file($1 . ".sgml");
} next;
# incomplete tag, so slurp another line }
$_ .= <FILE>;
} # Remove <link ...> tags, which might span multiple lines
while (m/<link/)
{
if (s/<link\s+linkend[^>]*>//)
{
next;
}
# Remove </link> too # incomplete tag, so slurp another line
s|</link>||g; $_ .= <FILE>;
}
print; # Remove </link> too
} s|</link>||g;
close(FILE);
print;
}
close(FILE);
} }
doc/src/sgml/mk_feature_tables.pl
View file @ 042d9ffc
...@@ -8,14 +8,18 @@ open PACK, $ARGV[1] or die; ...@@ -8,14 +8,18 @@ open PACK, $ARGV[1] or die;
my %feature_packages; my %feature_packages;
while (<PACK>) { while (<PACK>)
chomp; {
my ($fid, $pname) = split /\t/; chomp;
if ($feature_packages{$fid}) { my ($fid, $pname) = split /\t/;
$feature_packages{$fid} .= ", $pname"; if ($feature_packages{$fid})
} else { {
$feature_packages{$fid} = $pname; $feature_packages{$fid} .= ", $pname";
} }
else
{
$feature_packages{$fid} = $pname;
}
} }
close PACK; close PACK;
...@@ -24,33 +28,41 @@ open FEAT, $ARGV[2] or die; ...@@ -24,33 +28,41 @@ open FEAT, $ARGV[2] or die;
print "<tbody>\n"; print "<tbody>\n";
while (<FEAT>) { while (<FEAT>)
chomp; {
my ($feature_id, $feature_name, $subfeature_id, $subfeature_name, $is_supported, $comments) = split /\t/; chomp;
my ($feature_id, $feature_name, $subfeature_id,
$is_supported eq $yesno || next; $subfeature_name, $is_supported, $comments) = split /\t/;
$feature_name =~ s/</&lt;/g; $is_supported eq $yesno || next;
$feature_name =~ s/>/&gt;/g;
$subfeature_name =~ s/</&lt;/g; $feature_name =~ s/</&lt;/g;
$subfeature_name =~ s/>/&gt;/g; $feature_name =~ s/>/&gt;/g;
$subfeature_name =~ s/</&lt;/g;
print " <row>\n"; $subfeature_name =~ s/>/&gt;/g;
if ($subfeature_id) { print " <row>\n";
print " <entry>$feature_id-$subfeature_id</entry>\n";
} else { if ($subfeature_id)
print " <entry>$feature_id</entry>\n"; {
} print " <entry>$feature_id-$subfeature_id</entry>\n";
print " <entry>" . $feature_packages{$feature_id} . "</entry>\n"; }
if ($subfeature_id) { else
print " <entry>$subfeature_name</entry>\n"; {
} else { print " <entry>$feature_id</entry>\n";
print " <entry>$feature_name</entry>\n"; }
} print " <entry>" . $feature_packages{$feature_id} . "</entry>\n";
print " <entry>$comments</entry>\n"; if ($subfeature_id)
{
print " </row>\n"; print " <entry>$subfeature_name</entry>\n";
}
else
{
print " <entry>$feature_name</entry>\n";
}
print " <entry>$comments</entry>\n";
print " </row>\n";
} }
print "</tbody>\n"; print "</tbody>\n";
......
src/backend/catalog/Catalog.pm
View file @ 042d9ffc
...@@ -25,152 +25,160 @@ our @EXPORT_OK = qw(Catalogs RenameTempFile); ...@@ -25,152 +25,160 @@ our @EXPORT_OK = qw(Catalogs RenameTempFile);
# Returns a nested data structure describing the data in the headers. # Returns a nested data structure describing the data in the headers.
sub Catalogs sub Catalogs
{ {
my (%catalogs, $catname, $declaring_attributes, $most_recent); my (%catalogs, $catname, $declaring_attributes, $most_recent);
$catalogs{names} = []; $catalogs{names} = [];
# There are a few types which are given one name in the C source, but a # There are a few types which are given one name in the C source, but a
# different name at the SQL level. These are enumerated here. # different name at the SQL level. These are enumerated here.
my %RENAME_ATTTYPE = ( my %RENAME_ATTTYPE = (
'int16' => 'int2', 'int16' => 'int2',
'int32' => 'int4', 'int32' => 'int4',
'Oid' => 'oid', 'Oid' => 'oid',
'NameData' => 'name', 'NameData' => 'name',
'TransactionId' => 'xid' 'TransactionId' => 'xid');
);
foreach my $input_file (@_)
foreach my $input_file (@_) {
{ my %catalog;
my %catalog; $catalog{columns} = [];
$catalog{columns} = []; $catalog{data} = [];
$catalog{data} = [];
open(INPUT_FILE, '<', $input_file) || die "$input_file: $!";
open(INPUT_FILE, '<', $input_file) || die "$input_file: $!";
# Scan the input file.
# Scan the input file. while (<INPUT_FILE>)
while (<INPUT_FILE>) {
{
# Strip C-style comments. # Strip C-style comments.
s;/\*(.|\n)*\*/;;g; s;/\*(.|\n)*\*/;;g;
if (m;/\*;) if (m;/\*;)
{ {
# handle multi-line comments properly.
my $next_line = <INPUT_FILE>; # handle multi-line comments properly.
die "$input_file: ends within C-style comment\n" my $next_line = <INPUT_FILE>;
if !defined $next_line; die "$input_file: ends within C-style comment\n"
$_ .= $next_line; if !defined $next_line;
redo; $_ .= $next_line;
} redo;
}
# Strip useless whitespace and trailing semicolons.
chomp; # Strip useless whitespace and trailing semicolons.
s/^\s+//; chomp;
s/;\s*$//; s/^\s+//;
s/\s+/ /g; s/;\s*$//;
s/\s+/ /g;
# Push the data into the appropriate data structure.
if (/^DATA\(insert(\s+OID\s+=\s+(\d+))?\s+\(\s*(.*)\s*\)\s*\)$/) # Push the data into the appropriate data structure.
{ if (/^DATA\(insert(\s+OID\s+=\s+(\d+))?\s+\(\s*(.*)\s*\)\s*\)$/)
push @{ $catalog{data} }, {oid => $2, bki_values => $3}; {
} push @{ $catalog{data} }, { oid => $2, bki_values => $3 };
elsif (/^DESCR\(\"(.*)\"\)$/) }
{ elsif (/^DESCR\(\"(.*)\"\)$/)
$most_recent = $catalog{data}->[-1]; {
# this tests if most recent line is not a DATA() statement $most_recent = $catalog{data}->[-1];
if (ref $most_recent ne 'HASH')
{ # this tests if most recent line is not a DATA() statement
die "DESCR() does not apply to any catalog ($input_file)"; if (ref $most_recent ne 'HASH')
} {
if (!defined $most_recent->{oid}) die "DESCR() does not apply to any catalog ($input_file)";
{ }
die "DESCR() does not apply to any oid ($input_file)"; if (!defined $most_recent->{oid})
} {
elsif ($1 ne '') die "DESCR() does not apply to any oid ($input_file)";
{ }
$most_recent->{descr} = $1; elsif ($1 ne '')
} {
} $most_recent->{descr} = $1;
elsif (/^SHDESCR\(\"(.*)\"\)$/) }
{ }
$most_recent = $catalog{data}->[-1]; elsif (/^SHDESCR\(\"(.*)\"\)$/)
# this tests if most recent line is not a DATA() statement {
if (ref $most_recent ne 'HASH') $most_recent = $catalog{data}->[-1];
{
die "SHDESCR() does not apply to any catalog ($input_file)"; # this tests if most recent line is not a DATA() statement
} if (ref $most_recent ne 'HASH')
if (!defined $most_recent->{oid}) {
{ die
die "SHDESCR() does not apply to any oid ($input_file)"; "SHDESCR() does not apply to any catalog ($input_file)";
} }
elsif ($1 ne '') if (!defined $most_recent->{oid})
{ {
$most_recent->{shdescr} = $1; die "SHDESCR() does not apply to any oid ($input_file)";
} }
} elsif ($1 ne '')
elsif (/^DECLARE_TOAST\(\s*(\w+),\s*(\d+),\s*(\d+)\)/) {
{ $most_recent->{shdescr} = $1;
$catname = 'toasting'; }
my ($toast_name, $toast_oid, $index_oid) = ($1, $2, $3); }
push @{ $catalog{data} }, "declare toast $toast_oid $index_oid on $toast_name\n"; elsif (/^DECLARE_TOAST\(\s*(\w+),\s*(\d+),\s*(\d+)\)/)
} {
elsif (/^DECLARE_(UNIQUE_)?INDEX\(\s*(\w+),\s*(\d+),\s*(.+)\)/) $catname = 'toasting';
{ my ($toast_name, $toast_oid, $index_oid) = ($1, $2, $3);
$catname = 'indexing'; push @{ $catalog{data} },
my ($is_unique, $index_name, $index_oid, $using) = ($1, $2, $3, $4); "declare toast $toast_oid $index_oid on $toast_name\n";
push @{ $catalog{data} }, }
sprintf( elsif (/^DECLARE_(UNIQUE_)?INDEX\(\s*(\w+),\s*(\d+),\s*(.+)\)/)
"declare %sindex %s %s %s\n", {
$is_unique ? 'unique ' : '', $catname = 'indexing';
$index_name, $index_oid, $using my ($is_unique, $index_name, $index_oid, $using) =
); ($1, $2, $3, $4);
} push @{ $catalog{data} },
elsif (/^BUILD_INDICES/) sprintf(
{ "declare %sindex %s %s %s\n",
push @{ $catalog{data} }, "build indices\n"; $is_unique ? 'unique ' : '',
} $index_name, $index_oid, $using);
elsif (/^CATALOG\(([^,]*),(\d+)\)/) }
{ elsif (/^BUILD_INDICES/)
$catname = $1; {
$catalog{relation_oid} = $2; push @{ $catalog{data} }, "build indices\n";
}
# Store pg_* catalog names in the same order we receive them elsif (/^CATALOG\(([^,]*),(\d+)\)/)
push @{ $catalogs{names} }, $catname; {
$catname = $1;
$catalog{bootstrap} = /BKI_BOOTSTRAP/ ? ' bootstrap' : ''; $catalog{relation_oid} = $2;
$catalog{shared_relation} = /BKI_SHARED_RELATION/ ? ' shared_relation' : '';
$catalog{without_oids} = /BKI_WITHOUT_OIDS/ ? ' without_oids' : ''; # Store pg_* catalog names in the same order we receive them
$catalog{rowtype_oid} = /BKI_ROWTYPE_OID\((\d+)\)/ ? " rowtype_oid $1" : ''; push @{ $catalogs{names} }, $catname;
$catalog{schema_macro} = /BKI_SCHEMA_MACRO/ ? 'True' : '';
$declaring_attributes = 1; $catalog{bootstrap} = /BKI_BOOTSTRAP/ ? ' bootstrap' : '';
} $catalog{shared_relation} =
elsif ($declaring_attributes) /BKI_SHARED_RELATION/ ? ' shared_relation' : '';
{ $catalog{without_oids} =
next if (/^{|^$/); /BKI_WITHOUT_OIDS/ ? ' without_oids' : '';
next if (/^#/); $catalog{rowtype_oid} =
if (/^}/) /BKI_ROWTYPE_OID\((\d+)\)/ ? " rowtype_oid $1" : '';
{ $catalog{schema_macro} = /BKI_SCHEMA_MACRO/ ? 'True' : '';
undef $declaring_attributes; $declaring_attributes = 1;
} }
else elsif ($declaring_attributes)
{ {
my ($atttype, $attname) = split /\s+/, $_; next if (/^{|^$/);
die "parse error ($input_file)" unless $attname; next if (/^#/);
if (exists $RENAME_ATTTYPE{$atttype}) if (/^}/)
{ {
$atttype = $RENAME_ATTTYPE{$atttype}; undef $declaring_attributes;
} }
if ($attname =~ /(.*)\[.*\]/) # array attribute else
{ {
$attname = $1; my ($atttype, $attname) = split /\s+/, $_;
$atttype .= '[]'; # variable-length only die "parse error ($input_file)" unless $attname;
} if (exists $RENAME_ATTTYPE{$atttype})
push @{ $catalog{columns} }, {$attname => $atttype}; {
} $atttype = $RENAME_ATTTYPE{$atttype};
} }
} if ($attname =~ /(.*)\[.*\]/) # array attribute
$catalogs{$catname} = \%catalog; {
close INPUT_FILE; $attname = $1;
} $atttype .= '[]'; # variable-length only
return \%catalogs; }
push @{ $catalog{columns} }, { $attname => $atttype };
}
}
}
$catalogs{$catname} = \%catalog;
close INPUT_FILE;
}
return \%catalogs;
} }
# Rename temporary files to final names. # Rename temporary files to final names.
...@@ -179,11 +187,11 @@ sub Catalogs ...@@ -179,11 +187,11 @@ sub Catalogs
# can't use the same temp files # can't use the same temp files
sub RenameTempFile sub RenameTempFile
{ {
my $final_name = shift; my $final_name = shift;
my $extension = shift; my $extension = shift;
my $temp_name = $final_name . $extension; my $temp_name = $final_name . $extension;
print "Writing $final_name\n"; print "Writing $final_name\n";
rename($temp_name, $final_name) || die "rename: $temp_name: $!"; rename($temp_name, $final_name) || die "rename: $temp_name: $!";
} }
1; 1;
src/backend/catalog/genbki.pl
View file @ 042d9ffc
...@@ -27,44 +27,44 @@ my $major_version; ...@@ -27,44 +27,44 @@ my $major_version;
# Process command line switches. # Process command line switches.
while (@ARGV) while (@ARGV)
{ {
my $arg = shift @ARGV; my $arg = shift @ARGV;
if ($arg !~ /^-/) if ($arg !~ /^-/)
{ {
push @input_files, $arg; push @input_files, $arg;
} }
elsif ($arg =~ /^-o/) elsif ($arg =~ /^-o/)
{ {
$output_path = length($arg) > 2 ? substr($arg, 2) : shift @ARGV; $output_path = length($arg) > 2 ? substr($arg, 2) : shift @ARGV;
} }
elsif ($arg =~ /^-I/) elsif ($arg =~ /^-I/)
{ {
push @include_path, length($arg) > 2 ? substr($arg, 2) : shift @ARGV; push @include_path, length($arg) > 2 ? substr($arg, 2) : shift @ARGV;
} }
elsif ($arg =~ /^--set-version=(.*)$/) elsif ($arg =~ /^--set-version=(.*)$/)
{ {
$major_version = $1; $major_version = $1;
die "Version must be in format nn.nn.\n" die "Version must be in format nn.nn.\n"
if !($major_version =~ /^\d+\.\d+$/); if !($major_version =~ /^\d+\.\d+$/);
} }
else else
{ {
usage(); usage();
} }
} }
# Sanity check arguments. # Sanity check arguments.
die "No input files.\n" if !@input_files; die "No input files.\n" if !@input_files;
die "No include path; you must specify -I at least once.\n" if !@include_path; die "No include path; you must specify -I at least once.\n" if !@include_path;
die "--set-version must be specified.\n" if !defined $major_version; die "--set-version must be specified.\n" if !defined $major_version;
# Make sure output_path ends in a slash. # Make sure output_path ends in a slash.
if ($output_path ne '' && substr($output_path, -1) ne '/') if ($output_path ne '' && substr($output_path, -1) ne '/')
{ {
$output_path .= '/'; $output_path .= '/';
} }
# Open temp files # Open temp files
my $tmpext = ".tmp$$"; my $tmpext = ".tmp$$";
my $bkifile = $output_path . 'postgres.bki'; my $bkifile = $output_path . 'postgres.bki';
open BKI, '>', $bkifile . $tmpext open BKI, '>', $bkifile . $tmpext
or die "can't open $bkifile$tmpext: $!"; or die "can't open $bkifile$tmpext: $!";
...@@ -86,8 +86,10 @@ open SHDESCR, '>', $shdescrfile . $tmpext ...@@ -86,8 +86,10 @@ open SHDESCR, '>', $shdescrfile . $tmpext
# to handle those sorts of things is in initdb.c's bootstrap_template1().) # to handle those sorts of things is in initdb.c's bootstrap_template1().)
# NB: make sure that the files used here are known to be part of the .bki # NB: make sure that the files used here are known to be part of the .bki
# file's dependencies by src/backend/catalog/Makefile. # file's dependencies by src/backend/catalog/Makefile.
my $BOOTSTRAP_SUPERUSERID = find_defined_symbol('pg_authid.h', 'BOOTSTRAP_SUPERUSERID'); my $BOOTSTRAP_SUPERUSERID =
my $PG_CATALOG_NAMESPACE = find_defined_symbol('pg_namespace.h', 'PG_CATALOG_NAMESPACE'); find_defined_symbol('pg_authid.h', 'BOOTSTRAP_SUPERUSERID');
my $PG_CATALOG_NAMESPACE =
find_defined_symbol('pg_namespace.h', 'PG_CATALOG_NAMESPACE');
# Read all the input header files into internal data structures # Read all the input header files into internal data structures
my $catalogs = Catalog::Catalogs(@input_files); my $catalogs = Catalog::Catalogs(@input_files);
...@@ -103,155 +105,164 @@ my @tables_needing_macros; ...@@ -103,155 +105,164 @@ my @tables_needing_macros;
our @types; our @types;
# produce output, one catalog at a time # produce output, one catalog at a time
foreach my $catname ( @{ $catalogs->{names} } ) foreach my $catname (@{ $catalogs->{names} })
{ {
# .bki CREATE command for this catalog
my $catalog = $catalogs->{$catname}; # .bki CREATE command for this catalog
print BKI "create $catname $catalog->{relation_oid}" my $catalog = $catalogs->{$catname};
. $catalog->{shared_relation} print BKI "create $catname $catalog->{relation_oid}"
. $catalog->{bootstrap} . $catalog->{shared_relation}
. $catalog->{without_oids} . $catalog->{bootstrap}
. $catalog->{rowtype_oid}. "\n"; . $catalog->{without_oids}
. $catalog->{rowtype_oid} . "\n";
my %bki_attr;
my @attnames; my %bki_attr;
foreach my $column ( @{ $catalog->{columns} } ) my @attnames;
{ foreach my $column (@{ $catalog->{columns} })
my ($attname, $atttype) = %$column; {
$bki_attr{$attname} = $atttype; my ($attname, $atttype) = %$column;
push @attnames, $attname; $bki_attr{$attname} = $atttype;
} push @attnames, $attname;
print BKI " (\n"; }
print BKI join " ,\n", map(" $_ = $bki_attr{$_}", @attnames); print BKI " (\n";
print BKI "\n )\n"; print BKI join " ,\n", map(" $_ = $bki_attr{$_}", @attnames);
print BKI "\n )\n";
# open it, unless bootstrap case (create bootstrap does this automatically)
if ($catalog->{bootstrap} eq '') # open it, unless bootstrap case (create bootstrap does this automatically)
{ if ($catalog->{bootstrap} eq '')
print BKI "open $catname\n"; {
} print BKI "open $catname\n";
}
if (defined $catalog->{data})
{ if (defined $catalog->{data})
# Ordinary catalog with DATA line(s) {
foreach my $row ( @{ $catalog->{data} } )
{ # Ordinary catalog with DATA line(s)
# substitute constant values we acquired above foreach my $row (@{ $catalog->{data} })
$row->{bki_values} =~ s/\bPGUID\b/$BOOTSTRAP_SUPERUSERID/g; {
$row->{bki_values} =~ s/\bPGNSP\b/$PG_CATALOG_NAMESPACE/g;
# substitute constant values we acquired above
# Save pg_type info for pg_attribute processing below $row->{bki_values} =~ s/\bPGUID\b/$BOOTSTRAP_SUPERUSERID/g;
if ($catname eq 'pg_type') $row->{bki_values} =~ s/\bPGNSP\b/$PG_CATALOG_NAMESPACE/g;
{
my %type; # Save pg_type info for pg_attribute processing below
$type{oid} = $row->{oid}; if ($catname eq 'pg_type')
@type{@attnames} = split /\s+/, $row->{bki_values}; {
push @types, \%type; my %type;
} $type{oid} = $row->{oid};
@type{@attnames} = split /\s+/, $row->{bki_values};
# Write to postgres.bki push @types, \%type;
my $oid = $row->{oid} ? "OID = $row->{oid} " : ''; }
printf BKI "insert %s( %s)\n", $oid, $row->{bki_values};
# Write to postgres.bki
# Write comments to postgres.description and postgres.shdescription my $oid = $row->{oid} ? "OID = $row->{oid} " : '';
if (defined $row->{descr}) printf BKI "insert %s( %s)\n", $oid, $row->{bki_values};
{
printf DESCR "%s\t%s\t0\t%s\n", $row->{oid}, $catname, $row->{descr}; # Write comments to postgres.description and postgres.shdescription
} if (defined $row->{descr})
if (defined $row->{shdescr}) {
{ printf DESCR "%s\t%s\t0\t%s\n", $row->{oid}, $catname,
printf SHDESCR "%s\t%s\t%s\n", $row->{oid}, $catname, $row->{shdescr}; $row->{descr};
} }
} if (defined $row->{shdescr})
} {
if ($catname eq 'pg_attribute') printf SHDESCR "%s\t%s\t%s\n", $row->{oid}, $catname,
{ $row->{shdescr};
# For pg_attribute.h, we generate DATA entries ourselves. }
# NB: pg_type.h must come before pg_attribute.h in the input list }
# of catalog names, since we use info from pg_type.h here. }
foreach my $table_name ( @{ $catalogs->{names} } ) if ($catname eq 'pg_attribute')
{ {
my $table = $catalogs->{$table_name};
# For pg_attribute.h, we generate DATA entries ourselves.
# Currently, all bootstrapped relations also need schemapg.h # NB: pg_type.h must come before pg_attribute.h in the input list
# entries, so skip if the relation isn't to be in schemapg.h. # of catalog names, since we use info from pg_type.h here.
next if $table->{schema_macro} ne 'True'; foreach my $table_name (@{ $catalogs->{names} })
{
$schemapg_entries{$table_name} = []; my $table = $catalogs->{$table_name};
push @tables_needing_macros, $table_name;
my $is_bootstrap = $table->{bootstrap}; # Currently, all bootstrapped relations also need schemapg.h
# entries, so skip if the relation isn't to be in schemapg.h.
# Generate entries for user attributes. next if $table->{schema_macro} ne 'True';
my $attnum = 0;
my $priornotnull = 1; $schemapg_entries{$table_name} = [];
my @user_attrs = @{ $table->{columns} }; push @tables_needing_macros, $table_name;
foreach my $attr (@user_attrs) my $is_bootstrap = $table->{bootstrap};
{
$attnum++; # Generate entries for user attributes.
my $row = emit_pgattr_row($table_name, $attr, $priornotnull); my $attnum = 0;
$row->{attnum} = $attnum; my $priornotnull = 1;
$row->{attstattarget} = '-1'; my @user_attrs = @{ $table->{columns} };
$priornotnull &= ($row->{attnotnull} eq 't'); foreach my $attr (@user_attrs)
{
# If it's bootstrapped, put an entry in postgres.bki. $attnum++;
if ($is_bootstrap eq ' bootstrap') my $row = emit_pgattr_row($table_name, $attr, $priornotnull);
{ $row->{attnum} = $attnum;
bki_insert($row, @attnames); $row->{attstattarget} = '-1';
} $priornotnull &= ($row->{attnotnull} eq 't');
# Store schemapg entries for later. # If it's bootstrapped, put an entry in postgres.bki.
$row = emit_schemapg_row($row, grep { $bki_attr{$_} eq 'bool' } @attnames); if ($is_bootstrap eq ' bootstrap')
push @{ $schemapg_entries{$table_name} }, {
'{ ' . join(', ', grep { defined $_ } bki_insert($row, @attnames);
map $row->{$_}, @attnames) . ' }'; }
}
# Store schemapg entries for later.
# Generate entries for system attributes. $row =
# We only need postgres.bki entries, not schemapg.h entries. emit_schemapg_row($row,
if ($is_bootstrap eq ' bootstrap') grep { $bki_attr{$_} eq 'bool' } @attnames);
{ push @{ $schemapg_entries{$table_name} }, '{ '
$attnum = 0; . join(
my @SYS_ATTRS = ( ', ', grep { defined $_ }
{ctid => 'tid'}, map $row->{$_}, @attnames) . ' }';
{oid => 'oid'}, }
{xmin => 'xid'},
{cmin => 'cid'}, # Generate entries for system attributes.
{xmax => 'xid'}, # We only need postgres.bki entries, not schemapg.h entries.
{cmax => 'cid'}, if ($is_bootstrap eq ' bootstrap')
{tableoid => 'oid'} {
); $attnum = 0;
foreach my $attr (@SYS_ATTRS) my @SYS_ATTRS = (
{ { ctid => 'tid' },
$attnum--; { oid => 'oid' },
my $row = emit_pgattr_row($table_name, $attr, 1); { xmin => 'xid' },
$row->{attnum} = $attnum; { cmin => 'cid' },
$row->{attstattarget} = '0'; { xmax => 'xid' },
{ cmax => 'cid' },
# some catalogs don't have oids { tableoid => 'oid' });
next if $table->{without_oids} eq ' without_oids' && foreach my $attr (@SYS_ATTRS)
$row->{attname} eq 'oid'; {
$attnum--;
bki_insert($row, @attnames); my $row = emit_pgattr_row($table_name, $attr, 1);
} $row->{attnum} = $attnum;
} $row->{attstattarget} = '0';
}
} # some catalogs don't have oids
next
print BKI "close $catname\n"; if $table->{without_oids} eq ' without_oids'
&& $row->{attname} eq 'oid';
bki_insert($row, @attnames);
}
}
}
}
print BKI "close $catname\n";
} }
# Any information needed for the BKI that is not contained in a pg_*.h header # Any information needed for the BKI that is not contained in a pg_*.h header
# (i.e., not contained in a header with a CATALOG() statement) comes here # (i.e., not contained in a header with a CATALOG() statement) comes here
# Write out declare toast/index statements # Write out declare toast/index statements
foreach my $declaration ( @{ $catalogs->{toasting}->{data} } ) foreach my $declaration (@{ $catalogs->{toasting}->{data} })
{ {
print BKI $declaration; print BKI $declaration;
} }
foreach my $declaration ( @{ $catalogs->{indexing}->{data} } ) foreach my $declaration (@{ $catalogs->{indexing}->{data} })
{ {
print BKI $declaration; print BKI $declaration;
} }
...@@ -283,9 +294,9 @@ EOM ...@@ -283,9 +294,9 @@ EOM
# Emit schemapg declarations # Emit schemapg declarations
foreach my $table_name (@tables_needing_macros) foreach my $table_name (@tables_needing_macros)
{ {
print SCHEMAPG "\n#define Schema_$table_name \\\n"; print SCHEMAPG "\n#define Schema_$table_name \\\n";
print SCHEMAPG join ", \\\n", @{ $schemapg_entries{$table_name} }; print SCHEMAPG join ", \\\n", @{ $schemapg_entries{$table_name} };
print SCHEMAPG "\n"; print SCHEMAPG "\n";
} }
# Closing boilerplate for schemapg.h # Closing boilerplate for schemapg.h
...@@ -298,9 +309,9 @@ close DESCR; ...@@ -298,9 +309,9 @@ close DESCR;
close SHDESCR; close SHDESCR;
# Finally, rename the completed files into place. # Finally, rename the completed files into place.
Catalog::RenameTempFile($bkifile, $tmpext); Catalog::RenameTempFile($bkifile, $tmpext);
Catalog::RenameTempFile($schemafile, $tmpext); Catalog::RenameTempFile($schemafile, $tmpext);
Catalog::RenameTempFile($descrfile, $tmpext); Catalog::RenameTempFile($descrfile, $tmpext);
Catalog::RenameTempFile($shdescrfile, $tmpext); Catalog::RenameTempFile($shdescrfile, $tmpext);
exit 0; exit 0;
...@@ -314,137 +325,140 @@ exit 0; ...@@ -314,137 +325,140 @@ exit 0;
# columns were all not-null. # columns were all not-null.
sub emit_pgattr_row sub emit_pgattr_row
{ {
my ($table_name, $attr, $priornotnull) = @_; my ($table_name, $attr, $priornotnull) = @_;
my ($attname, $atttype) = %$attr; my ($attname, $atttype) = %$attr;
my %row; my %row;
$row{attrelid} = $catalogs->{$table_name}->{relation_oid}; $row{attrelid} = $catalogs->{$table_name}->{relation_oid};
$row{attname} = $attname; $row{attname} = $attname;
# Adjust type name for arrays: foo[] becomes _foo # Adjust type name for arrays: foo[] becomes _foo
# so we can look it up in pg_type # so we can look it up in pg_type
if ($atttype =~ /(.+)\[\]$/) if ($atttype =~ /(.+)\[\]$/)
{ {
$atttype = '_' . $1; $atttype = '_' . $1;
} }
# Copy the type data from pg_type, and add some type-dependent items # Copy the type data from pg_type, and add some type-dependent items
foreach my $type (@types) foreach my $type (@types)
{ {
if ( defined $type->{typname} && $type->{typname} eq $atttype ) if (defined $type->{typname} && $type->{typname} eq $atttype)
{ {
$row{atttypid} = $type->{oid}; $row{atttypid} = $type->{oid};
$row{attlen} = $type->{typlen}; $row{attlen} = $type->{typlen};
$row{attbyval} = $type->{typbyval}; $row{attbyval} = $type->{typbyval};
$row{attstorage} = $type->{typstorage}; $row{attstorage} = $type->{typstorage};
$row{attalign} = $type->{typalign}; $row{attalign} = $type->{typalign};
# set attndims if it's an array type
$row{attndims} = $type->{typcategory} eq 'A' ? '1' : '0'; # set attndims if it's an array type
$row{attcollation} = $type->{typcollation}; $row{attndims} = $type->{typcategory} eq 'A' ? '1' : '0';
# attnotnull must be set true if the type is fixed-width and $row{attcollation} = $type->{typcollation};
# prior columns are too --- compare DefineAttr in bootstrap.c.
# oidvector and int2vector are also treated as not-nullable. # attnotnull must be set true if the type is fixed-width and
if ($priornotnull) # prior columns are too --- compare DefineAttr in bootstrap.c.
{ # oidvector and int2vector are also treated as not-nullable.
$row{attnotnull} = if ($priornotnull)
$type->{typname} eq 'oidvector' ? 't' {
: $type->{typname} eq 'int2vector' ? 't' $row{attnotnull} =
: $type->{typlen} eq 'NAMEDATALEN' ? 't' $type->{typname} eq 'oidvector' ? 't'
: $type->{typlen} > 0 ? 't' : 'f'; : $type->{typname} eq 'int2vector' ? 't'
} : $type->{typlen} eq 'NAMEDATALEN' ? 't'
else : $type->{typlen} > 0 ? 't'
{ : 'f';
$row{attnotnull} = 'f'; }
} else
last; {
} $row{attnotnull} = 'f';
} }
last;
# Add in default values for pg_attribute }
my %PGATTR_DEFAULTS = ( }
attcacheoff => '-1',
atttypmod => '-1', # Add in default values for pg_attribute
atthasdef => 'f', my %PGATTR_DEFAULTS = (
attisdropped => 'f', attcacheoff => '-1',
attislocal => 't', atttypmod => '-1',
attinhcount => '0', atthasdef => 'f',
attacl => '_null_', attisdropped => 'f',
attoptions => '_null_', attislocal => 't',
attfdwoptions => '_null_' attinhcount => '0',
); attacl => '_null_',
return {%PGATTR_DEFAULTS, %row}; attoptions => '_null_',
attfdwoptions => '_null_');
return { %PGATTR_DEFAULTS, %row };
} }
# Write a pg_attribute entry to postgres.bki # Write a pg_attribute entry to postgres.bki
sub bki_insert sub bki_insert
{ {
my $row = shift; my $row = shift;
my @attnames = @_; my @attnames = @_;
my $oid = $row->{oid} ? "OID = $row->{oid} " : ''; my $oid = $row->{oid} ? "OID = $row->{oid} " : '';
my $bki_values = join ' ', map $row->{$_}, @attnames; my $bki_values = join ' ', map $row->{$_}, @attnames;
printf BKI "insert %s( %s)\n", $oid, $bki_values; printf BKI "insert %s( %s)\n", $oid, $bki_values;
} }
# The field values of a Schema_pg_xxx declaration are similar, but not # The field values of a Schema_pg_xxx declaration are similar, but not
# quite identical, to the corresponding values in postgres.bki. # quite identical, to the corresponding values in postgres.bki.
sub emit_schemapg_row sub emit_schemapg_row
{ {
my $row = shift; my $row = shift;
my @bool_attrs = @_; my @bool_attrs = @_;
# Supply appropriate quoting for these fields. # Supply appropriate quoting for these fields.
$row->{attname} = q|{"| . $row->{attname} . q|"}|; $row->{attname} = q|{"| . $row->{attname} . q|"}|;
$row->{attstorage} = q|'| . $row->{attstorage} . q|'|; $row->{attstorage} = q|'| . $row->{attstorage} . q|'|;
$row->{attalign} = q|'| . $row->{attalign} . q|'|; $row->{attalign} = q|'| . $row->{attalign} . q|'|;
# We don't emit initializers for the variable length fields at all. # We don't emit initializers for the variable length fields at all.
# Only the fixed-size portions of the descriptors are ever used. # Only the fixed-size portions of the descriptors are ever used.
delete $row->{attacl}; delete $row->{attacl};
delete $row->{attoptions}; delete $row->{attoptions};
delete $row->{attfdwoptions}; delete $row->{attfdwoptions};
# Expand booleans from 'f'/'t' to 'false'/'true'. # Expand booleans from 'f'/'t' to 'false'/'true'.
# Some values might be other macros (eg FLOAT4PASSBYVAL), don't change. # Some values might be other macros (eg FLOAT4PASSBYVAL), don't change.
foreach my $attr (@bool_attrs) foreach my $attr (@bool_attrs)
{ {
$row->{$attr} = $row->{$attr} =
$row->{$attr} eq 't' ? 'true' $row->{$attr} eq 't' ? 'true'
: $row->{$attr} eq 'f' ? 'false' : $row->{$attr} eq 'f' ? 'false'
: $row->{$attr}; : $row->{$attr};
} }
return $row; return $row;
} }
# Find a symbol defined in a particular header file and extract the value. # Find a symbol defined in a particular header file and extract the value.
sub find_defined_symbol sub find_defined_symbol
{ {
my ($catalog_header, $symbol) = @_; my ($catalog_header, $symbol) = @_;
for my $path (@include_path) for my $path (@include_path)
{ {
# Make sure include path ends in a slash.
if (substr($path, -1) ne '/') # Make sure include path ends in a slash.
{ if (substr($path, -1) ne '/')
$path .= '/'; {
} $path .= '/';
my $file = $path . $catalog_header; }
next if !-f $file; my $file = $path . $catalog_header;
open(FIND_DEFINED_SYMBOL, '<', $file) || die "$file: $!"; next if !-f $file;
while (<FIND_DEFINED_SYMBOL>) open(FIND_DEFINED_SYMBOL, '<', $file) || die "$file: $!";
{ while (<FIND_DEFINED_SYMBOL>)
if (/^#define\s+\Q$symbol\E\s+(\S+)/) {
{ if (/^#define\s+\Q$symbol\E\s+(\S+)/)
return $1; {
} return $1;
} }
close FIND_DEFINED_SYMBOL; }
die "$file: no definition found for $symbol\n"; close FIND_DEFINED_SYMBOL;
} die "$file: no definition found for $symbol\n";
die "$catalog_header: not found in any include directory\n"; }
die "$catalog_header: not found in any include directory\n";
} }
sub usage sub usage
{ {
die <<EOM; die <<EOM;
Usage: genbki.pl [options] header... Usage: genbki.pl [options] header...
Options: Options:
......
src/backend/utils/Gen_fmgrtab.pl
View file @ 042d9ffc
...@@ -19,29 +19,29 @@ use strict; ...@@ -19,29 +19,29 @@ use strict;
use warnings; use warnings;
# Collect arguments # Collect arguments
my $infile; # pg_proc.h my $infile; # pg_proc.h
my $output_path = ''; my $output_path = '';
while (@ARGV) while (@ARGV)
{ {
my $arg = shift @ARGV; my $arg = shift @ARGV;
if ($arg !~ /^-/) if ($arg !~ /^-/)
{ {
$infile = $arg; $infile = $arg;
} }
elsif ($arg =~ /^-o/) elsif ($arg =~ /^-o/)
{ {
$output_path = length($arg) > 2 ? substr($arg, 2) : shift @ARGV; $output_path = length($arg) > 2 ? substr($arg, 2) : shift @ARGV;
} }
else else
{ {
usage(); usage();
} }
} }
# Make sure output_path ends in a slash. # Make sure output_path ends in a slash.
if ($output_path ne '' && substr($output_path, -1) ne '/') if ($output_path ne '' && substr($output_path, -1) ne '/')
{ {
$output_path .= '/'; $output_path .= '/';
} }
# Read all the data from the include/catalog files. # Read all the data from the include/catalog files.
...@@ -50,48 +50,47 @@ my $catalogs = Catalog::Catalogs($infile); ...@@ -50,48 +50,47 @@ my $catalogs = Catalog::Catalogs($infile);
# Collect the raw data from pg_proc.h. # Collect the raw data from pg_proc.h.
my @fmgr = (); my @fmgr = ();
my @attnames; my @attnames;
foreach my $column ( @{ $catalogs->{pg_proc}->{columns} } ) foreach my $column (@{ $catalogs->{pg_proc}->{columns} })
{ {
push @attnames, keys %$column; push @attnames, keys %$column;
} }
my $data = $catalogs->{pg_proc}->{data}; my $data = $catalogs->{pg_proc}->{data};
foreach my $row (@$data) foreach my $row (@$data)
{ {
# To construct fmgroids.h and fmgrtab.c, we need to inspect some
# of the individual data fields. Just splitting on whitespace # To construct fmgroids.h and fmgrtab.c, we need to inspect some
# won't work, because some quoted fields might contain internal # of the individual data fields. Just splitting on whitespace
# whitespace. We handle this by folding them all to a simple # won't work, because some quoted fields might contain internal
# "xxx". Fortunately, this script doesn't need to look at any # whitespace. We handle this by folding them all to a simple
# fields that might need quoting, so this simple hack is # "xxx". Fortunately, this script doesn't need to look at any
# sufficient. # fields that might need quoting, so this simple hack is
$row->{bki_values} =~ s/"[^"]*"/"xxx"/g; # sufficient.
@{$row}{@attnames} = split /\s+/, $row->{bki_values}; $row->{bki_values} =~ s/"[^"]*"/"xxx"/g;
@{$row}{@attnames} = split /\s+/, $row->{bki_values};
# Select out just the rows for internal-language procedures.
# Note assumption here that INTERNALlanguageId is 12. # Select out just the rows for internal-language procedures.
next if $row->{prolang} ne '12'; # Note assumption here that INTERNALlanguageId is 12.
next if $row->{prolang} ne '12';
push @fmgr,
{ push @fmgr,
oid => $row->{oid}, { oid => $row->{oid},
strict => $row->{proisstrict}, strict => $row->{proisstrict},
retset => $row->{proretset}, retset => $row->{proretset},
nargs => $row->{pronargs}, nargs => $row->{pronargs},
prosrc => $row->{prosrc}, prosrc => $row->{prosrc}, };
};
# Hack to work around memory leak in some versions of Perl
# Hack to work around memory leak in some versions of Perl $row = undef;
$row = undef;
} }
# Emit headers for both files # Emit headers for both files
my $tmpext = ".tmp$$"; my $tmpext = ".tmp$$";
my $oidsfile = $output_path . 'fmgroids.h'; my $oidsfile = $output_path . 'fmgroids.h';
my $tabfile = $output_path . 'fmgrtab.c'; my $tabfile = $output_path . 'fmgrtab.c';
open H, '>', $oidsfile . $tmpext or die "Could not open $oidsfile$tmpext: $!"; open H, '>', $oidsfile . $tmpext or die "Could not open $oidsfile$tmpext: $!";
open T, '>', $tabfile . $tmpext or die "Could not open $tabfile$tmpext: $!"; open T, '>', $tabfile . $tmpext or die "Could not open $tabfile$tmpext: $!";
print H print H
qq|/*------------------------------------------------------------------------- qq|/*-------------------------------------------------------------------------
...@@ -160,12 +159,12 @@ qq|/*------------------------------------------------------------------------- ...@@ -160,12 +159,12 @@ qq|/*-------------------------------------------------------------------------
# Emit #define's and extern's -- only one per prosrc value # Emit #define's and extern's -- only one per prosrc value
my %seenit; my %seenit;
foreach my $s (sort {$a->{oid} <=> $b->{oid}} @fmgr) foreach my $s (sort { $a->{oid} <=> $b->{oid} } @fmgr)
{ {
next if $seenit{$s->{prosrc}}; next if $seenit{ $s->{prosrc} };
$seenit{$s->{prosrc}} = 1; $seenit{ $s->{prosrc} } = 1;
print H "#define F_" . uc $s->{prosrc} . " $s->{oid}\n"; print H "#define F_" . uc $s->{prosrc} . " $s->{oid}\n";
print T "extern Datum $s->{prosrc} (PG_FUNCTION_ARGS);\n"; print T "extern Datum $s->{prosrc} (PG_FUNCTION_ARGS);\n";
} }
# Create the fmgr_builtins table # Create the fmgr_builtins table
...@@ -173,10 +172,10 @@ print T "\nconst FmgrBuiltin fmgr_builtins[] = {\n"; ...@@ -173,10 +172,10 @@ print T "\nconst FmgrBuiltin fmgr_builtins[] = {\n";
my %bmap; my %bmap;
$bmap{'t'} = 'true'; $bmap{'t'} = 'true';
$bmap{'f'} = 'false'; $bmap{'f'} = 'false';
foreach my $s (sort {$a->{oid} <=> $b->{oid}} @fmgr) foreach my $s (sort { $a->{oid} <=> $b->{oid} } @fmgr)
{ {
print T print T
" { $s->{oid}, \"$s->{prosrc}\", $s->{nargs}, $bmap{$s->{strict}}, $bmap{$s->{retset}}, $s->{prosrc} },\n"; " { $s->{oid}, \"$s->{prosrc}\", $s->{nargs}, $bmap{$s->{strict}}, $bmap{$s->{retset}}, $s->{prosrc} },\n";
} }
# And add the file footers. # And add the file footers.
...@@ -198,11 +197,11 @@ close(T); ...@@ -198,11 +197,11 @@ close(T);
# Finally, rename the completed files into place. # Finally, rename the completed files into place.
Catalog::RenameTempFile($oidsfile, $tmpext); Catalog::RenameTempFile($oidsfile, $tmpext);
Catalog::RenameTempFile($tabfile, $tmpext); Catalog::RenameTempFile($tabfile, $tmpext);
sub usage sub usage
{ {
die <<EOM; die <<EOM;
Usage: perl -I [directory of Catalog.pm] Gen_fmgrtab.pl [path to pg_proc.h] Usage: perl -I [directory of Catalog.pm] Gen_fmgrtab.pl [path to pg_proc.h]
Gen_fmgrtab.pl generates fmgroids.h and fmgrtab.c from pg_proc.h Gen_fmgrtab.pl generates fmgroids.h and fmgrtab.c from pg_proc.h
......
src/backend/utils/generate-errcodes.pl
View file @ 042d9ffc
...@@ -6,36 +6,41 @@ ...@@ -6,36 +6,41 @@
use warnings; use warnings;
use strict; use strict;
print "/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n"; print
"/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n";
print "/* there is deliberately not an #ifndef ERRCODES_H here */\n"; print "/* there is deliberately not an #ifndef ERRCODES_H here */\n";
open my $errcodes, $ARGV[0] or die; open my $errcodes, $ARGV[0] or die;
while (<$errcodes>) { while (<$errcodes>)
chomp; {
chomp;
# Skip comments # Skip comments
next if /^#/; next if /^#/;
next if /^\s*$/; next if /^\s*$/;
# Emit a comment for each section header # Emit a comment for each section header
if (/^Section:(.*)/) { if (/^Section:(.*)/)
{
my $header = $1; my $header = $1;
$header =~ s/^\s+//; $header =~ s/^\s+//;
print "\n/* $header */\n"; print "\n/* $header */\n";
next; next;
} }
die "unable to parse errcodes.txt" unless /^([^\s]{5})\s+[EWS]\s+([^\s]+)/; die "unable to parse errcodes.txt"
unless /^([^\s]{5})\s+[EWS]\s+([^\s]+)/;
(my $sqlstate, my $errcode_macro) = ($1, $2); (my $sqlstate, my $errcode_macro) = ($1, $2);
# Split the sqlstate letters # Split the sqlstate letters
$sqlstate = join ",", split "", $sqlstate; $sqlstate = join ",", split "", $sqlstate;
# And quote them
$sqlstate =~ s/([^,])/'$1'/g;
print "#define $errcode_macro MAKE_SQLSTATE($sqlstate)\n"; # And quote them
$sqlstate =~ s/([^,])/'$1'/g;
print "#define $errcode_macro MAKE_SQLSTATE($sqlstate)\n";
} }
close $errcodes; close $errcodes;
src/backend/utils/mb/Unicode/UCS_to_BIG5.pl
View file @ 042d9ffc
...@@ -33,68 +33,82 @@ require "ucs2utf.pl"; ...@@ -33,68 +33,82 @@ require "ucs2utf.pl";
# #
$in_file = "BIG5.TXT"; $in_file = "BIG5.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
reset 'array'; reset 'array';
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $c, $u, $rest ) = split; ($c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){ if ($array{$utf} ne "")
printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; {
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$array{ $utf } = $code; $array{$utf} = $code;
} }
} }
close( FILE ); close(FILE);
$in_file = "CP950.TXT"; $in_file = "CP950.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $c, $u, $rest ) = split; ($c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
# Pick only the ETEN extended characters in the range 0xf9d6 - 0xf9dc # Pick only the ETEN extended characters in the range 0xf9d6 - 0xf9dc
# from CP950.TXT # from CP950.TXT
if( $code >= 0x80 && $ucs >= 0x0080 && if ( $code >= 0x80
$code >= 0xf9d6 && $code <= 0xf9dc ){ && $ucs >= 0x0080
&& $code >= 0xf9d6
&& $code <= 0xf9dc)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){ if ($array{$utf} ne "")
printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; {
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$array{ $utf } = $code; $array{$utf} = $code;
} }
} }
close( FILE ); close(FILE);
$file = lc("utf8_to_big5.map"); $file = lc("utf8_to_big5.map");
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "static pg_utf_to_local ULmapBIG5[ $count ] = {\n"; print FILE "static pg_utf_to_local ULmapBIG5[ $count ] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$code = $array{ $index }; {
$code = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $code; printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
} else { }
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $code; printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
} }
} }
...@@ -107,67 +121,81 @@ close(FILE); ...@@ -107,67 +121,81 @@ close(FILE);
# #
$in_file = "BIG5.TXT"; $in_file = "BIG5.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
reset 'array'; reset 'array';
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $c, $u, $rest ) = split; ($c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){ if ($array{$utf} ne "")
printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; {
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$array{ $code } = $utf; $array{$code} = $utf;
} }
} }
close( FILE ); close(FILE);
$in_file = "CP950.TXT"; $in_file = "CP950.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $c, $u, $rest ) = split; ($c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
# Pick only the ETEN extended characters in the range 0xf9d6 - 0xf9dc # Pick only the ETEN extended characters in the range 0xf9d6 - 0xf9dc
# from CP950.TXT # from CP950.TXT
if( $code >= 0x80 && $ucs >= 0x0080 && if ( $code >= 0x80
$code >= 0xf9d6 && $code <= 0xf9dc ){ && $ucs >= 0x0080
&& $code >= 0xf9d6
&& $code <= 0xf9dc)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){ if ($array{$utf} ne "")
printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; {
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$array{ $code } = $utf; $array{$code} = $utf;
} }
} }
close( FILE ); close(FILE);
$file = lc("big5_to_utf8.map"); $file = lc("big5_to_utf8.map");
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "static pg_local_to_utf LUmapBIG5[ $count ] = {\n"; print FILE "static pg_local_to_utf LUmapBIG5[ $count ] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$utf = $array{ $index }; {
$utf = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $utf; printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
} else { }
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $utf; printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
} }
} }
......
src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl
View file @ 042d9ffc
...@@ -22,43 +22,51 @@ require "ucs2utf.pl"; ...@@ -22,43 +22,51 @@ require "ucs2utf.pl";
$in_file = "GB2312.TXT"; $in_file = "GB2312.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $c, $u, $rest ) = split; ($c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){ if ($array{$utf} ne "")
printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; {
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$array{ $utf } = ($code | 0x8080); $array{$utf} = ($code | 0x8080);
} }
} }
close( FILE ); close(FILE);
# #
# first, generate UTF8 --> EUC_CN table # first, generate UTF8 --> EUC_CN table
# #
$file = "utf8_to_euc_cn.map"; $file = "utf8_to_euc_cn.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "static pg_utf_to_local ULmapEUC_CN[ $count ] = {\n"; print FILE "static pg_utf_to_local ULmapEUC_CN[ $count ] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$code = $array{ $index }; {
$code = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $code; printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
} else { }
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $code; printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
} }
} }
...@@ -71,39 +79,47 @@ close(FILE); ...@@ -71,39 +79,47 @@ close(FILE);
# #
reset 'array'; reset 'array';
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $c, $u, $rest ) = split; ($c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){ if ($array{$code} ne "")
printf STDERR "Warning: duplicate code: %04x\n",$ucs; {
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$code |= 0x8080; $code |= 0x8080;
$array{ $code } = $utf; $array{$code} = $utf;
} }
} }
close( FILE ); close(FILE);
$file = "euc_cn_to_utf8.map"; $file = "euc_cn_to_utf8.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "static pg_local_to_utf LUmapEUC_CN[ $count ] = {\n"; print FILE "static pg_local_to_utf LUmapEUC_CN[ $count ] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$utf = $array{ $index }; {
$utf = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $utf; printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
} else { }
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $utf; printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
} }
} }
......
src/backend/utils/mb/Unicode/UCS_to_EUC_JIS_2004.pl
View file @ 042d9ffc
...@@ -15,89 +15,110 @@ $TEST = 1; ...@@ -15,89 +15,110 @@ $TEST = 1;
$in_file = "euc-jis-2004-std.txt"; $in_file = "euc-jis-2004-std.txt";
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
reset 'array'; reset 'array';
reset 'array1'; reset 'array1';
reset 'comment'; reset 'comment';
reset 'comment1'; reset 'comment1';
while($line = <FILE> ){ while ($line = <FILE>)
if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/) { {
$c = $1; if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/)
$u1 = $2; {
$u2 = $3; $c = $1;
$rest = "U+" . $u1 . "+" . $u2 . $4; $u1 = $2;
$code = hex($c); $u2 = $3;
$ucs = hex($u1); $rest = "U+" . $u1 . "+" . $u2 . $4;
$utf1 = &ucs2utf($ucs); $code = hex($c);
$ucs = hex($u2); $ucs = hex($u1);
$utf2 = &ucs2utf($ucs); $utf1 = &ucs2utf($ucs);
$str = sprintf "%08x%08x", $utf1, $utf2; $ucs = hex($u2);
$array1{ $str } = $code; $utf2 = &ucs2utf($ucs);
$comment1{ $str } = $rest; $str = sprintf "%08x%08x", $utf1, $utf2;
$array1{$str} = $code;
$comment1{$str} = $rest;
$count1++; $count1++;
next; next;
} elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/) { }
$c = $1; elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/)
$u = $2; {
$c = $1;
$u = $2;
$rest = "U+" . $u . $3; $rest = "U+" . $u . $3;
} else { }
else
{
next; next;
} }
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){ if ($array{$utf} ne "")
printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; {
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$array{ $utf } = $code; $array{$utf} = $code;
$comment{ $code } = $rest; $comment{$code} = $rest;
} }
close( FILE ); close(FILE);
$file = "utf8_to_euc_jis_2004.map"; $file = "utf8_to_euc_jis_2004.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "/*\n"; print FILE "/*\n";
print FILE " * This file was generated by UCS_to_EUC_JIS_2004.pl\n"; print FILE " * This file was generated by UCS_to_EUC_JIS_2004.pl\n";
print FILE " */\n"; print FILE " */\n";
print FILE "static pg_utf_to_local ULmapEUC_JIS_2004[] = {\n"; print FILE "static pg_utf_to_local ULmapEUC_JIS_2004[] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$code = $array{ $index }; {
$code = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
printf FILE " {0x%08x, 0x%06x} /* %s */\n", $index, $code, $comment{ $code }; {
} else { printf FILE " {0x%08x, 0x%06x} /* %s */\n", $index, $code,
printf FILE " {0x%08x, 0x%06x}, /* %s */\n", $index, $code, $comment{ $code }; $comment{$code};
}
else
{
printf FILE " {0x%08x, 0x%06x}, /* %s */\n", $index, $code,
$comment{$code};
} }
} }
print FILE "};\n"; print FILE "};\n";
close(FILE); close(FILE);
if ($TEST == 1) { if ($TEST == 1)
{
$file1 = "utf8.data"; $file1 = "utf8.data";
$file2 = "euc_jis_2004.data"; $file2 = "euc_jis_2004.data";
open( FILE1, "> $file1" ) || die( "cannot open $file1" ); open(FILE1, "> $file1") || die("cannot open $file1");
open( FILE2, "> $file2" ) || die( "cannot open $file2" ); open(FILE2, "> $file2") || die("cannot open $file2");
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$code = $array{ $index }; {
if ($code > 0x00 && $code != 0x09 && $code != 0x0a && $code != 0x0d && $code = $array{$index};
$code != 0x5c && if ( $code > 0x00
($code < 0x80 || && $code != 0x09
($code >= 0x8ea1 && $code <= 0x8efe) || && $code != 0x0a
($code >= 0x8fa1a1 && $code <= 0x8ffefe) || && $code != 0x0d
($code >= 0xa1a1 && $code <= 0x8fefe))) { && $code != 0x5c
for ($i = 3; $i >= 0; $i--) { && ( $code < 0x80
$s = $i * 8; || ($code >= 0x8ea1 && $code <= 0x8efe)
|| ($code >= 0x8fa1a1 && $code <= 0x8ffefe)
|| ($code >= 0xa1a1 && $code <= 0x8fefe)))
{
for ($i = 3; $i >= 0; $i--)
{
$s = $i * 8;
$mask = 0xff << $s; $mask = 0xff << $s;
print FILE1 pack("C", ($index & $mask) >> $s) if $index & $mask; print FILE1 pack("C", ($index & $mask) >> $s)
if $index & $mask;
print FILE2 pack("C", ($code & $mask) >> $s) if $code & $mask; print FILE2 pack("C", ($code & $mask) >> $s) if $code & $mask;
} }
print FILE1 "\n"; print FILE1 "\n";
...@@ -107,46 +128,62 @@ if ($TEST == 1) { ...@@ -107,46 +128,62 @@ if ($TEST == 1) {
} }
$file = "utf8_to_euc_jis_2004_combined.map"; $file = "utf8_to_euc_jis_2004_combined.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "/*\n"; print FILE "/*\n";
print FILE " * This file was generated by UCS_to_EUC_JIS_2004.pl\n"; print FILE " * This file was generated by UCS_to_EUC_JIS_2004.pl\n";
print FILE " */\n"; print FILE " */\n";
print FILE "static pg_utf_to_local_combined ULmapEUC_JIS_2004_combined[] = {\n"; print FILE
"static pg_utf_to_local_combined ULmapEUC_JIS_2004_combined[] = {\n";
for $index ( sort {$a cmp $b} keys( %array1 ) ){ for $index (sort { $a cmp $b } keys(%array1))
$code = $array1{ $index }; {
$code = $array1{$index};
$count1--; $count1--;
if( $count1 == 0 ){ if ($count1 == 0)
printf FILE " {0x%s, 0x%s, 0x%06x} /* %s */\n", substr($index, 0, 8), substr($index, 8, 8), $code, $comment1{ $index }; {
} else { printf FILE " {0x%s, 0x%s, 0x%06x} /* %s */\n", substr($index, 0, 8),
printf FILE " {0x%s, 0x%s, 0x%06x}, /* %s */\n", substr($index, 0, 8), substr($index, 8, 8), $code, $comment1{ $index }; substr($index, 8, 8), $code, $comment1{$index};
}
else
{
printf FILE " {0x%s, 0x%s, 0x%06x}, /* %s */\n",
substr($index, 0, 8), substr($index, 8, 8), $code,
$comment1{$index};
} }
} }
print FILE "};\n"; print FILE "};\n";
close(FILE); close(FILE);
if ($TEST == 1) { if ($TEST == 1)
for $index ( sort {$a cmp $b} keys( %array1 ) ){ {
$code = $array1{ $index }; for $index (sort { $a cmp $b } keys(%array1))
if ($code > 0x00 && $code != 0x09 && $code != 0x0a && $code != 0x0d && {
$code != 0x5c && $code = $array1{$index};
($code < 0x80 || if ( $code > 0x00
($code >= 0x8ea1 && $code <= 0x8efe) || && $code != 0x09
($code >= 0x8fa1a1 && $code <= 0x8ffefe) || && $code != 0x0a
($code >= 0xa1a1 && $code <= 0x8fefe))) { && $code != 0x0d
&& $code != 0x5c
&& ( $code < 0x80
|| ($code >= 0x8ea1 && $code <= 0x8efe)
|| ($code >= 0x8fa1a1 && $code <= 0x8ffefe)
|| ($code >= 0xa1a1 && $code <= 0x8fefe)))
{
$v1 = hex(substr($index, 0, 8)); $v1 = hex(substr($index, 0, 8));
$v2 = hex(substr($index, 8, 8)); $v2 = hex(substr($index, 8, 8));
for ($i = 3; $i >= 0; $i--) { for ($i = 3; $i >= 0; $i--)
$s = $i * 8; {
$s = $i * 8;
$mask = 0xff << $s; $mask = 0xff << $s;
print FILE1 pack("C", ($v1 & $mask) >> $s) if $v1 & $mask; print FILE1 pack("C", ($v1 & $mask) >> $s) if $v1 & $mask;
print FILE2 pack("C", ($code & $mask) >> $s) if $code & $mask; print FILE2 pack("C", ($code & $mask) >> $s) if $code & $mask;
} }
for ($i = 3; $i >= 0; $i--) { for ($i = 3; $i >= 0; $i--)
$s = $i * 8; {
$s = $i * 8;
$mask = 0xff << $s; $mask = 0xff << $s;
print FILE1 pack("C", ($v2 & $mask) >> $s) if $v2 & $mask; print FILE1 pack("C", ($v2 & $mask) >> $s) if $v2 & $mask;
} }
...@@ -162,65 +199,78 @@ if ($TEST == 1) { ...@@ -162,65 +199,78 @@ if ($TEST == 1) {
$in_file = "euc-jis-2004-std.txt"; $in_file = "euc-jis-2004-std.txt";
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
reset 'array'; reset 'array';
reset 'array1'; reset 'array1';
reset 'comment'; reset 'comment';
reset 'comment1'; reset 'comment1';
while($line = <FILE> ){ while ($line = <FILE>)
if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/) { {
$c = $1; if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/)
$u1 = $2; {
$u2 = $3; $c = $1;
$rest = "U+" . $u1 . "+" . $u2 . $4; $u1 = $2;
$code = hex($c); $u2 = $3;
$ucs = hex($u1); $rest = "U+" . $u1 . "+" . $u2 . $4;
$utf1 = &ucs2utf($ucs); $code = hex($c);
$ucs = hex($u2); $ucs = hex($u1);
$utf2 = &ucs2utf($ucs); $utf1 = &ucs2utf($ucs);
$str = sprintf "%08x%08x", $utf1, $utf2; $ucs = hex($u2);
$array1{ $code } = $str; $utf2 = &ucs2utf($ucs);
$comment1{ $code } = $rest; $str = sprintf "%08x%08x", $utf1, $utf2;
$array1{$code} = $str;
$comment1{$code} = $rest;
$count1++; $count1++;
next; next;
} elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/) { }
$c = $1; elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/)
$u = $2; {
$c = $1;
$u = $2;
$rest = "U+" . $u . $3; $rest = "U+" . $u . $3;
} else { }
else
{
next; next;
} }
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){ if ($array{$code} ne "")
printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; {
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$array{ $code } = $utf; $array{$code} = $utf;
$comment{ $utf } = $rest; $comment{$utf} = $rest;
} }
close( FILE ); close(FILE);
$file = "euc_jis_2004_to_utf8.map"; $file = "euc_jis_2004_to_utf8.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "/*\n"; print FILE "/*\n";
print FILE " * This file was generated by UCS_to_EUC_JIS_2004.pl\n"; print FILE " * This file was generated by UCS_to_EUC_JIS_2004.pl\n";
print FILE " */\n"; print FILE " */\n";
print FILE "static pg_local_to_utf LUmapEUC_JIS_2004[] = {\n"; print FILE "static pg_local_to_utf LUmapEUC_JIS_2004[] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$code = $array{ $index }; {
$code = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
printf FILE " {0x%06x, 0x%08x} /* %s */\n", $index, $code, $comment{ $code }; {
} else { printf FILE " {0x%06x, 0x%08x} /* %s */\n", $index, $code,
printf FILE " {0x%06x, 0x%08x}, /* %s */\n", $index, $code, $comment{ $code }; $comment{$code};
}
else
{
printf FILE " {0x%06x, 0x%08x}, /* %s */\n", $index, $code,
$comment{$code};
} }
} }
...@@ -228,19 +278,26 @@ print FILE "};\n"; ...@@ -228,19 +278,26 @@ print FILE "};\n";
close(FILE); close(FILE);
$file = "euc_jis_2004_to_utf8_combined.map"; $file = "euc_jis_2004_to_utf8_combined.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "/*\n"; print FILE "/*\n";
print FILE " * This file was generated by UCS_to_EUC_JIS_2004.pl\n"; print FILE " * This file was generated by UCS_to_EUC_JIS_2004.pl\n";
print FILE " */\n"; print FILE " */\n";
print FILE "static pg_local_to_utf_combined LUmapEUC_JIS_2004_combined[] = {\n"; print FILE
"static pg_local_to_utf_combined LUmapEUC_JIS_2004_combined[] = {\n";
for $index ( sort {$a <=> $b} keys( %array1 ) ){ for $index (sort { $a <=> $b } keys(%array1))
$code = $array1{ $index }; {
$code = $array1{$index};
$count1--; $count1--;
if( $count1 == 0 ){ if ($count1 == 0)
printf FILE " {0x%06x, 0x%s, 0x%s} /* %s */\n", $index, substr($code, 0, 8), substr($code, 8, 8), $comment1{ $index }; {
} else { printf FILE " {0x%06x, 0x%s, 0x%s} /* %s */\n", $index,
printf FILE " {0x%06x, 0x%s, 0x%s}, /* %s */\n", $index, substr($code, 0, 8), substr($code, 8, 8), $comment1{ $index }; substr($code, 0, 8), substr($code, 8, 8), $comment1{$index};
}
else
{
printf FILE " {0x%06x, 0x%s, 0x%s}, /* %s */\n", $index,
substr($code, 0, 8), substr($code, 8, 8), $comment1{$index};
} }
} }
......
src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl
View file @ 042d9ffc
...@@ -36,102 +36,118 @@ require "ucs2utf.pl"; ...@@ -36,102 +36,118 @@ require "ucs2utf.pl";
# #
$in_file = "JIS0201.TXT"; $in_file = "JIS0201.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
reset 'array'; reset 'array';
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $c, $u, $rest ) = split; ($c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){ if ($array{$utf} ne "")
printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; {
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
# add single shift 2 # add single shift 2
$array{ $utf } = ($code | 0x8e00); $array{$utf} = ($code | 0x8e00);
} }
} }
close( FILE ); close(FILE);
# #
# JIS0208 # JIS0208
# #
$in_file = "JIS0208.TXT"; $in_file = "JIS0208.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $s, $c, $u, $rest ) = split; ($s, $c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){ if ($array{$utf} ne "")
printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; {
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$array{ $utf } = ($code | 0x8080); $array{$utf} = ($code | 0x8080);
} }
} }
close( FILE ); close(FILE);
# #
# JIS0212 # JIS0212
# #
$in_file = "JIS0212.TXT"; $in_file = "JIS0212.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $c, $u, $rest ) = split; ($c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){ if ($array{$utf} ne "")
printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; {
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$array{ $utf } = ($code | 0x8f8080); $array{$utf} = ($code | 0x8f8080);
} }
} }
close( FILE ); close(FILE);
# #
# first, generate UTF8 --> EUC_JP table # first, generate UTF8 --> EUC_JP table
# #
$file = "utf8_to_euc_jp.map"; $file = "utf8_to_euc_jp.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "static pg_utf_to_local ULmapEUC_JP[ $count ] = {\n"; print FILE "static pg_utf_to_local ULmapEUC_JP[ $count ] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$code = $array{ $index }; {
$code = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $code; printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
} else { }
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $code; printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
} }
} }
...@@ -148,100 +164,116 @@ close(FILE); ...@@ -148,100 +164,116 @@ close(FILE);
# #
$in_file = "JIS0201.TXT"; $in_file = "JIS0201.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
reset 'array'; reset 'array';
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $c, $u, $rest ) = split; ($c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){ if ($array{$code} ne "")
printf STDERR "Warning: duplicate code: %04x\n",$ucs; {
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
# add single shift 2 # add single shift 2
$code |= 0x8e00; $code |= 0x8e00;
$array{ $code } = $utf; $array{$code} = $utf;
} }
} }
close( FILE ); close(FILE);
# #
# JIS0208 # JIS0208
# #
$in_file = "JIS0208.TXT"; $in_file = "JIS0208.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $s, $c, $u, $rest ) = split; ($s, $c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){ if ($array{$code} ne "")
printf STDERR "Warning: duplicate code: %04x\n",$ucs; {
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$code |= 0x8080; $code |= 0x8080;
$array{ $code } = $utf; $array{$code} = $utf;
} }
} }
close( FILE ); close(FILE);
# #
# JIS0212 # JIS0212
# #
$in_file = "JIS0212.TXT"; $in_file = "JIS0212.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $c, $u, $rest ) = split; ($c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){ if ($array{$code} ne "")
printf STDERR "Warning: duplicate code: %04x\n",$ucs; {
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$code |= 0x8f8080; $code |= 0x8f8080;
$array{ $code } = $utf; $array{$code} = $utf;
} }
} }
close( FILE ); close(FILE);
$file = "euc_jp_to_utf8.map"; $file = "euc_jp_to_utf8.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "static pg_local_to_utf LUmapEUC_JP[ $count ] = {\n"; print FILE "static pg_local_to_utf LUmapEUC_JP[ $count ] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$utf = $array{ $index }; {
$utf = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $utf; printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
} else { }
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $utf; printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
} }
} }
......
src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl
View file @ 042d9ffc
...@@ -22,43 +22,51 @@ require "ucs2utf.pl"; ...@@ -22,43 +22,51 @@ require "ucs2utf.pl";
$in_file = "KSX1001.TXT"; $in_file = "KSX1001.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $c, $u, $rest ) = split; ($c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){ if ($array{$utf} ne "")
printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; {
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$array{ $utf } = ($code | 0x8080); $array{$utf} = ($code | 0x8080);
} }
} }
close( FILE ); close(FILE);
# #
# first, generate UTF8 --> EUC_KR table # first, generate UTF8 --> EUC_KR table
# #
$file = "utf8_to_euc_kr.map"; $file = "utf8_to_euc_kr.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "static pg_utf_to_local ULmapEUC_KR[ $count ] = {\n"; print FILE "static pg_utf_to_local ULmapEUC_KR[ $count ] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$code = $array{ $index }; {
$code = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $code; printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
} else { }
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $code; printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
} }
} }
...@@ -71,39 +79,47 @@ close(FILE); ...@@ -71,39 +79,47 @@ close(FILE);
# #
reset 'array'; reset 'array';
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $c, $u, $rest ) = split; ($c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){ if ($array{$code} ne "")
printf STDERR "Warning: duplicate code: %04x\n",$ucs; {
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$code |= 0x8080; $code |= 0x8080;
$array{ $code } = $utf; $array{$code} = $utf;
} }
} }
close( FILE ); close(FILE);
$file = "euc_kr_to_utf8.map"; $file = "euc_kr_to_utf8.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "static pg_local_to_utf LUmapEUC_KR[ $count ] = {\n"; print FILE "static pg_local_to_utf LUmapEUC_KR[ $count ] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$utf = $array{ $index }; {
$utf = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $utf; printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
} else { }
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $utf; printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
} }
} }
......
src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl
View file @ 042d9ffc
...@@ -23,53 +23,66 @@ require "ucs2utf.pl"; ...@@ -23,53 +23,66 @@ require "ucs2utf.pl";
$in_file = "CNS11643.TXT"; $in_file = "CNS11643.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $c, $u, $rest ) = split; ($c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){ if ($array{$utf} ne "")
printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; {
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$plane = ($code & 0x1f0000) >> 16; $plane = ($code & 0x1f0000) >> 16;
if ($plane > 16) { if ($plane > 16)
{
printf STDERR "Warning: invalid plane No.$plane. ignored\n"; printf STDERR "Warning: invalid plane No.$plane. ignored\n";
next; next;
} }
if ($plane == 1) { if ($plane == 1)
$array{ $utf } = (($code & 0xffff) | 0x8080); {
} else { $array{$utf} = (($code & 0xffff) | 0x8080);
$array{ $utf } = (0x8ea00000 + ($plane << 16)) | (($code & 0xffff) | 0x8080); }
else
{
$array{$utf} =
(0x8ea00000 + ($plane << 16)) | (($code & 0xffff) | 0x8080);
} }
} }
} }
close( FILE ); close(FILE);
# #
# first, generate UTF8 --> EUC_TW table # first, generate UTF8 --> EUC_TW table
# #
$file = "utf8_to_euc_tw.map"; $file = "utf8_to_euc_tw.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "static pg_utf_to_local ULmapEUC_TW[ $count ] = {\n"; print FILE "static pg_utf_to_local ULmapEUC_TW[ $count ] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$code = $array{ $index }; {
$code = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $code; printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
} else { }
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $code; printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
} }
} }
...@@ -82,50 +95,60 @@ close(FILE); ...@@ -82,50 +95,60 @@ close(FILE);
# #
reset 'array'; reset 'array';
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $c, $u, $rest ) = split; ($c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){ if ($array{$code} ne "")
printf STDERR "Warning: duplicate code: %04x\n",$ucs; {
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$plane = ($code & 0x1f0000) >> 16; $plane = ($code & 0x1f0000) >> 16;
if ($plane > 16) { if ($plane > 16)
{
printf STDERR "Warning: invalid plane No.$plane. ignored\n"; printf STDERR "Warning: invalid plane No.$plane. ignored\n";
next; next;
} }
if ($plane == 1) { if ($plane == 1)
{
$c = (($code & 0xffff) | 0x8080); $c = (($code & 0xffff) | 0x8080);
$array{ $c } = $utf; $array{$c} = $utf;
$count++; $count++;
} }
$c = (0x8ea00000 + ($plane << 16)) | (($code & 0xffff) | 0x8080); $c = (0x8ea00000 + ($plane << 16)) | (($code & 0xffff) | 0x8080);
$array{ $c } = $utf; $array{$c} = $utf;
} }
} }
close( FILE ); close(FILE);
$file = "euc_tw_to_utf8.map"; $file = "euc_tw_to_utf8.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "static pg_local_to_utf LUmapEUC_TW[ $count ] = {\n"; print FILE "static pg_local_to_utf LUmapEUC_TW[ $count ] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$utf = $array{ $index }; {
$utf = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $utf; printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
} else { }
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $utf; printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
} }
} }
......
src/backend/utils/mb/Unicode/UCS_to_GB18030.pl
View file @ 042d9ffc
...@@ -18,28 +18,32 @@ require "ucs2utf.pl"; ...@@ -18,28 +18,32 @@ require "ucs2utf.pl";
$in_file = "ISO10646-GB18030.TXT"; $in_file = "ISO10646-GB18030.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $u, $c, $rest ) = split; ($u, $c, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){ if ($array{$utf} ne "")
printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; {
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$array{ $utf } = $code; $array{$utf} = $code;
} }
} }
close( FILE ); close(FILE);
# #
...@@ -47,15 +51,19 @@ close( FILE ); ...@@ -47,15 +51,19 @@ close( FILE );
# #
$file = "utf8_to_gb18030.map"; $file = "utf8_to_gb18030.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "static pg_utf_to_local ULmapGB18030[ $count ] = {\n"; print FILE "static pg_utf_to_local ULmapGB18030[ $count ] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$code = $array{ $index }; {
$code = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $code; printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
} else { }
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $code; printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
} }
} }
...@@ -69,38 +77,46 @@ close(FILE); ...@@ -69,38 +77,46 @@ close(FILE);
# #
reset 'array'; reset 'array';
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $u, $c, $rest ) = split; ($u, $c, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){ if ($array{$code} ne "")
printf STDERR "Warning: duplicate code: %04x\n",$ucs; {
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$array{ $code } = $utf; $array{$code} = $utf;
} }
} }
close( FILE ); close(FILE);
$file = "gb18030_to_utf8.map"; $file = "gb18030_to_utf8.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "static pg_local_to_utf LUmapGB18030[ $count ] = {\n"; print FILE "static pg_local_to_utf LUmapGB18030[ $count ] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$utf = $array{ $index }; {
$utf = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $utf; printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
} else { }
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $utf; printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
} }
} }
......
src/backend/utils/mb/Unicode/UCS_to_SHIFT_JIS_2004.pl
View file @ 042d9ffc
...@@ -13,65 +13,80 @@ require "ucs2utf.pl"; ...@@ -13,65 +13,80 @@ require "ucs2utf.pl";
$in_file = "sjis-0213-2004-std.txt"; $in_file = "sjis-0213-2004-std.txt";
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
reset 'array'; reset 'array';
reset 'array1'; reset 'array1';
reset 'comment'; reset 'comment';
reset 'comment1'; reset 'comment1';
while($line = <FILE> ){ while ($line = <FILE>)
if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/) { {
$c = $1; if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/)
$u1 = $2; {
$u2 = $3; $c = $1;
$rest = "U+" . $u1 . "+" . $u2 . $4; $u1 = $2;
$code = hex($c); $u2 = $3;
$ucs = hex($u1); $rest = "U+" . $u1 . "+" . $u2 . $4;
$utf1 = &ucs2utf($ucs); $code = hex($c);
$ucs = hex($u2); $ucs = hex($u1);
$utf2 = &ucs2utf($ucs); $utf1 = &ucs2utf($ucs);
$str = sprintf "%08x%08x", $utf1, $utf2; $ucs = hex($u2);
$array1{ $str } = $code; $utf2 = &ucs2utf($ucs);
$comment1{ $str } = $rest; $str = sprintf "%08x%08x", $utf1, $utf2;
$array1{$str} = $code;
$comment1{$str} = $rest;
$count1++; $count1++;
next; next;
} elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/) { }
$c = $1; elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/)
$u = $2; {
$c = $1;
$u = $2;
$rest = "U+" . $u . $3; $rest = "U+" . $u . $3;
} else { }
else
{
next; next;
} }
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){ if ($array{$utf} ne "")
printf STDERR "Warning: duplicate UTF8: %08x UCS: %04x Shift JIS: %04x\n",$utf, $ucs, $code; {
printf STDERR
"Warning: duplicate UTF8: %08x UCS: %04x Shift JIS: %04x\n", $utf,
$ucs, $code;
next; next;
} }
$count++; $count++;
$array{ $utf } = $code; $array{$utf} = $code;
$comment{ $code } = $rest; $comment{$code} = $rest;
} }
close( FILE ); close(FILE);
$file = "utf8_to_shift_jis_2004.map"; $file = "utf8_to_shift_jis_2004.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "/*\n"; print FILE "/*\n";
print FILE " * This file was generated by UCS_to_SHIFT_JIS_2004.pl\n"; print FILE " * This file was generated by UCS_to_SHIFT_JIS_2004.pl\n";
print FILE " */\n"; print FILE " */\n";
print FILE "static pg_utf_to_local ULmapSHIFT_JIS_2004[] = {\n"; print FILE "static pg_utf_to_local ULmapSHIFT_JIS_2004[] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$code = $array{ $index }; {
$code = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
printf FILE " {0x%08x, 0x%06x} /* %s */\n", $index, $code, $comment{ $code }; {
} else { printf FILE " {0x%08x, 0x%06x} /* %s */\n", $index, $code,
printf FILE " {0x%08x, 0x%06x}, /* %s */\n", $index, $code, $comment{ $code }; $comment{$code};
}
else
{
printf FILE " {0x%08x, 0x%06x}, /* %s */\n", $index, $code,
$comment{$code};
} }
} }
...@@ -79,19 +94,27 @@ print FILE "};\n"; ...@@ -79,19 +94,27 @@ print FILE "};\n";
close(FILE); close(FILE);
$file = "utf8_to_shift_jis_2004_combined.map"; $file = "utf8_to_shift_jis_2004_combined.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "/*\n"; print FILE "/*\n";
print FILE " * This file was generated by UCS_to_SHIFT_JIS_2004.pl\n"; print FILE " * This file was generated by UCS_to_SHIFT_JIS_2004.pl\n";
print FILE " */\n"; print FILE " */\n";
print FILE "static pg_utf_to_local_combined ULmapSHIFT_JIS_2004_combined[] = {\n"; print FILE
"static pg_utf_to_local_combined ULmapSHIFT_JIS_2004_combined[] = {\n";
for $index ( sort {$a cmp $b} keys( %array1 ) ){ for $index (sort { $a cmp $b } keys(%array1))
$code = $array1{ $index }; {
$code = $array1{$index};
$count1--; $count1--;
if( $count1 == 0 ){ if ($count1 == 0)
printf FILE " {0x%s, 0x%s, 0x%04x} /* %s */\n", substr($index, 0, 8), substr($index, 8, 8), $code, $comment1{ $index }; {
} else { printf FILE " {0x%s, 0x%s, 0x%04x} /* %s */\n", substr($index, 0, 8),
printf FILE " {0x%s, 0x%s, 0x%04x}, /* %s */\n", substr($index, 0, 8), substr($index, 8, 8), $code, $comment1{ $index }; substr($index, 8, 8), $code, $comment1{$index};
}
else
{
printf FILE " {0x%s, 0x%s, 0x%04x}, /* %s */\n",
substr($index, 0, 8), substr($index, 8, 8), $code,
$comment1{$index};
} }
} }
...@@ -102,66 +125,81 @@ close(FILE); ...@@ -102,66 +125,81 @@ close(FILE);
$in_file = "sjis-0213-2004-std.txt"; $in_file = "sjis-0213-2004-std.txt";
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
reset 'array'; reset 'array';
reset 'array1'; reset 'array1';
reset 'comment'; reset 'comment';
reset 'comment1'; reset 'comment1';
while($line = <FILE> ){ while ($line = <FILE>)
if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/) { {
$c = $1; if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/)
$u1 = $2; {
$u2 = $3; $c = $1;
$rest = "U+" . $u1 . "+" . $u2 . $4; $u1 = $2;
$code = hex($c); $u2 = $3;
$ucs = hex($u1); $rest = "U+" . $u1 . "+" . $u2 . $4;
$utf1 = &ucs2utf($ucs); $code = hex($c);
$ucs = hex($u2); $ucs = hex($u1);
$utf2 = &ucs2utf($ucs); $utf1 = &ucs2utf($ucs);
$str = sprintf "%08x%08x", $utf1, $utf2; $ucs = hex($u2);
$array1{ $code } = $str; $utf2 = &ucs2utf($ucs);
$comment1{ $code } = $rest; $str = sprintf "%08x%08x", $utf1, $utf2;
$array1{$code} = $str;
$comment1{$code} = $rest;
$count1++; $count1++;
next; next;
} elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/) { }
$c = $1; elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/)
$u = $2; {
$c = $1;
$u = $2;
$rest = "U+" . $u . $3; $rest = "U+" . $u . $3;
} else { }
else
{
next; next;
} }
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){ if ($array{$code} ne "")
printf STDERR "Warning: duplicate UTF-8: %08x UCS: %04x Shift JIS: %04x\n",$utf, $ucs, $code; {
printf STDERR "Previous value: UTF-8: %08x\n", $array{ $utf }; printf STDERR
"Warning: duplicate UTF-8: %08x UCS: %04x Shift JIS: %04x\n", $utf,
$ucs, $code;
printf STDERR "Previous value: UTF-8: %08x\n", $array{$utf};
next; next;
} }
$count++; $count++;
$array{ $code } = $utf; $array{$code} = $utf;
$comment{ $utf } = $rest; $comment{$utf} = $rest;
} }
close( FILE ); close(FILE);
$file = "shift_jis_2004_to_utf8.map"; $file = "shift_jis_2004_to_utf8.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "/*\n"; print FILE "/*\n";
print FILE " * This file was generated by UCS_to_SHIFTJIS_2004.pl\n"; print FILE " * This file was generated by UCS_to_SHIFTJIS_2004.pl\n";
print FILE " */\n"; print FILE " */\n";
print FILE "static pg_local_to_utf LUmapSHIFT_JIS_2004[] = {\n"; print FILE "static pg_local_to_utf LUmapSHIFT_JIS_2004[] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$code = $array{ $index }; {
$code = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
printf FILE " {0x%04x, 0x%08x} /* %s */\n", $index, $code, $comment{ $code }; {
} else { printf FILE " {0x%04x, 0x%08x} /* %s */\n", $index, $code,
printf FILE " {0x%04x, 0x%08x}, /* %s */\n", $index, $code, $comment{ $code }; $comment{$code};
}
else
{
printf FILE " {0x%04x, 0x%08x}, /* %s */\n", $index, $code,
$comment{$code};
} }
} }
...@@ -169,19 +207,26 @@ print FILE "};\n"; ...@@ -169,19 +207,26 @@ print FILE "};\n";
close(FILE); close(FILE);
$file = "shift_jis_2004_to_utf8_combined.map"; $file = "shift_jis_2004_to_utf8_combined.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "/*\n"; print FILE "/*\n";
print FILE " * This file was generated by UCS_to_SHIFT_JIS_2004.pl\n"; print FILE " * This file was generated by UCS_to_SHIFT_JIS_2004.pl\n";
print FILE " */\n"; print FILE " */\n";
print FILE "static pg_local_to_utf_combined LUmapSHIFT_JIS_2004_combined[] = {\n"; print FILE
"static pg_local_to_utf_combined LUmapSHIFT_JIS_2004_combined[] = {\n";
for $index ( sort {$a <=> $b} keys( %array1 ) ){ for $index (sort { $a <=> $b } keys(%array1))
$code = $array1{ $index }; {
$code = $array1{$index};
$count1--; $count1--;
if( $count1 == 0 ){ if ($count1 == 0)
printf FILE " {0x%04x, 0x%s, 0x%s} /* %s */\n", $index, substr($code, 0, 8), substr($code, 8, 8), $comment1{ $index }; {
} else { printf FILE " {0x%04x, 0x%s, 0x%s} /* %s */\n", $index,
printf FILE " {0x%04x, 0x%s, 0x%s}, /* %s */\n", $index, substr($code, 0, 8), substr($code, 8, 8), $comment1{ $index }; substr($code, 0, 8), substr($code, 8, 8), $comment1{$index};
}
else
{
printf FILE " {0x%04x, 0x%s, 0x%s}, /* %s */\n", $index,
substr($code, 0, 8), substr($code, 8, 8), $comment1{$index};
} }
} }
......
src/backend/utils/mb/Unicode/UCS_to_SJIS.pl
View file @ 042d9ffc
...@@ -22,60 +22,68 @@ require "ucs2utf.pl"; ...@@ -22,60 +22,68 @@ require "ucs2utf.pl";
# first generate UTF-8 --> SJIS table # first generate UTF-8 --> SJIS table
$in_file = "CP932.TXT"; $in_file = "CP932.TXT";
$count = 0; $count = 0;
open(FILE, $in_file) || die("cannot open $in_file");
open( FILE, $in_file ) || die( "cannot open $in_file" ); while (<FILE>)
{
while( <FILE> ){ chop;
chop; if (/^#/)
if( /^#/ ){ {
next; next;
} }
( $c, $u, $rest ) = split; ($c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){ if ($code >= 0x80 && $ucs >= 0x0080)
$utf = &ucs2utf($ucs); {
if((( $code >= 0xed40 ) $utf = &ucs2utf($ucs);
&& ( $code <= 0xeefc )) if ((($code >= 0xed40) && ($code <= 0xeefc))
|| (( $code >= 0x8754 ) || ( ($code >= 0x8754)
&&( $code <= 0x875d )) && ($code <= 0x875d))
|| ( $code == 0x878a ) || ($code == 0x878a)
|| ( $code == 0x8782 ) || ($code == 0x8782)
|| ( $code == 0x8784 ) || ($code == 0x8784)
|| ( $code == 0xfa5b ) || ($code == 0xfa5b)
|| ( $code == 0xfa54 ) || ($code == 0xfa54)
|| (( $code >= 0x8790 ) || ( ($code >= 0x8790)
&& ( $code <= 0x8792 )) && ($code <= 0x8792))
|| (( $code >= 0x8795 ) || ( ($code >= 0x8795)
&& ( $code <= 0x8797 )) && ($code <= 0x8797))
|| (( $code >= 0x879a ) || ( ($code >= 0x879a)
&& ( $code <= 0x879c ))) && ($code <= 0x879c)))
{ {
printf STDERR "Warning: duplicate UTF8 : UCS=0x%04x SJIS=0x%04x\n",$ucs,$code; printf STDERR
next; "Warning: duplicate UTF8 : UCS=0x%04x SJIS=0x%04x\n", $ucs,
} $code;
$count++; next;
$array{ $utf } = $code; }
} $count++;
$array{$utf} = $code;
}
} }
close( FILE ); close(FILE);
# #
# first, generate UTF8 --> SJIS table # first, generate UTF8 --> SJIS table
# #
$file = "utf8_to_sjis.map"; $file = "utf8_to_sjis.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "static pg_utf_to_local ULmapSJIS[ $count ] = {\n"; print FILE "static pg_utf_to_local ULmapSJIS[ $count ] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$code = $array{ $index }; {
$code = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $code; printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
} else { }
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $code; printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
} }
} }
...@@ -87,37 +95,44 @@ close(FILE); ...@@ -87,37 +95,44 @@ close(FILE);
# then generate SJIS --> UTF8 table # then generate SJIS --> UTF8 table
# #
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
reset 'array'; reset 'array';
$count = 0; $count = 0;
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $c, $u, $rest ) = split; ($c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
$count++; $count++;
$array{ $code } = $utf; $array{$code} = $utf;
} }
} }
close( FILE ); close(FILE);
$file = "sjis_to_utf8.map"; $file = "sjis_to_utf8.map";
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "static pg_local_to_utf LUmapSJIS[ $count ] = {\n"; print FILE "static pg_local_to_utf LUmapSJIS[ $count ] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$utf = $array{ $index }; {
$utf = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $utf; printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
} else { }
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $utf; printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
} }
} }
......
src/backend/utils/mb/Unicode/UCS_to_most.pl
View file @ 042d9ffc
...@@ -18,80 +18,88 @@ ...@@ -18,80 +18,88 @@
require "ucs2utf.pl"; require "ucs2utf.pl";
%filename = ( %filename = (
'WIN866' => 'CP866.TXT', 'WIN866' => 'CP866.TXT',
'WIN874' => 'CP874.TXT', 'WIN874' => 'CP874.TXT',
'WIN1250' => 'CP1250.TXT', 'WIN1250' => 'CP1250.TXT',
'WIN1251' => 'CP1251.TXT', 'WIN1251' => 'CP1251.TXT',
'WIN1252' => 'CP1252.TXT', 'WIN1252' => 'CP1252.TXT',
'WIN1253' => 'CP1253.TXT', 'WIN1253' => 'CP1253.TXT',
'WIN1254' => 'CP1254.TXT', 'WIN1254' => 'CP1254.TXT',
'WIN1255' => 'CP1255.TXT', 'WIN1255' => 'CP1255.TXT',
'WIN1256' => 'CP1256.TXT', 'WIN1256' => 'CP1256.TXT',
'WIN1257' => 'CP1257.TXT', 'WIN1257' => 'CP1257.TXT',
'WIN1258' => 'CP1258.TXT', 'WIN1258' => 'CP1258.TXT',
'ISO8859_2' => '8859-2.TXT', 'ISO8859_2' => '8859-2.TXT',
'ISO8859_3' => '8859-3.TXT', 'ISO8859_3' => '8859-3.TXT',
'ISO8859_4' => '8859-4.TXT', 'ISO8859_4' => '8859-4.TXT',
'ISO8859_5' => '8859-5.TXT', 'ISO8859_5' => '8859-5.TXT',
'ISO8859_6' => '8859-6.TXT', 'ISO8859_6' => '8859-6.TXT',
'ISO8859_7' => '8859-7.TXT', 'ISO8859_7' => '8859-7.TXT',
'ISO8859_8' => '8859-8.TXT', 'ISO8859_8' => '8859-8.TXT',
'ISO8859_9' => '8859-9.TXT', 'ISO8859_9' => '8859-9.TXT',
'ISO8859_10' => '8859-10.TXT', 'ISO8859_10' => '8859-10.TXT',
'ISO8859_13' => '8859-13.TXT', 'ISO8859_13' => '8859-13.TXT',
'ISO8859_14' => '8859-14.TXT', 'ISO8859_14' => '8859-14.TXT',
'ISO8859_15' => '8859-15.TXT', 'ISO8859_15' => '8859-15.TXT',
'ISO8859_16' => '8859-16.TXT', 'ISO8859_16' => '8859-16.TXT',
'KOI8R' => 'KOI8-R.TXT', 'KOI8R' => 'KOI8-R.TXT',
'KOI8U' => 'KOI8-U.TXT', 'KOI8U' => 'KOI8-U.TXT',
'GBK' => 'CP936.TXT', 'GBK' => 'CP936.TXT',
'UHC' => 'CP949.TXT', 'UHC' => 'CP949.TXT',
'JOHAB' => 'JOHAB.TXT', 'JOHAB' => 'JOHAB.TXT',);
);
@charsets = keys(filename); @charsets = keys(filename);
@charsets = @ARGV if scalar(@ARGV); @charsets = @ARGV if scalar(@ARGV);
foreach $charset (@charsets) { foreach $charset (@charsets)
{
# #
# first, generate UTF8-> charset table # first, generate UTF8-> charset table
# #
$in_file = $filename{$charset}; $in_file = $filename{$charset};
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
reset 'array'; reset 'array';
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $c, $u, $rest ) = split; ($c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){ if ($array{$utf} ne "")
printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; {
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$array{ $utf } = $code; $array{$utf} = $code;
} }
} }
close( FILE ); close(FILE);
$file = lc("utf8_to_${charset}.map"); $file = lc("utf8_to_${charset}.map");
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "static pg_utf_to_local ULmap${charset}[ $count ] = {\n"; print FILE "static pg_utf_to_local ULmap${charset}[ $count ] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$code = $array{ $index }; {
$code = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $code; printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
} else { }
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $code; printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
} }
} }
...@@ -99,42 +107,50 @@ foreach $charset (@charsets) { ...@@ -99,42 +107,50 @@ foreach $charset (@charsets) {
print FILE "};\n"; print FILE "};\n";
close(FILE); close(FILE);
# #
# then generate character set code ->UTF8 table # then generate character set code ->UTF8 table
# #
open( FILE, $in_file ) || die( "cannot open $in_file" ); open(FILE, $in_file) || die("cannot open $in_file");
reset 'array'; reset 'array';
while( <FILE> ){ while (<FILE>)
{
chop; chop;
if( /^#/ ){ if (/^#/)
{
next; next;
} }
( $c, $u, $rest ) = split; ($c, $u, $rest) = split;
$ucs = hex($u); $ucs = hex($u);
$code = hex($c); $code = hex($c);
if($code >= 0x80 && $ucs >= 0x0080){ if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs); $utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){ if ($array{$code} ne "")
printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; {
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next; next;
} }
$count++; $count++;
$array{ $code } = $utf; $array{$code} = $utf;
} }
} }
close( FILE ); close(FILE);
$file = lc("${charset}_to_utf8.map"); $file = lc("${charset}_to_utf8.map");
open( FILE, "> $file" ) || die( "cannot open $file" ); open(FILE, "> $file") || die("cannot open $file");
print FILE "static pg_local_to_utf LUmap${charset}[ $count ] = {\n"; print FILE "static pg_local_to_utf LUmap${charset}[ $count ] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){ for $index (sort { $a <=> $b } keys(%array))
$utf = $array{ $index }; {
$utf = $array{$index};
$count--; $count--;
if( $count == 0 ){ if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $utf; printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
} else { }
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $utf; printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
} }
} }
......
src/backend/utils/mb/Unicode/ucs2utf.pl
View file @ 042d9ffc
...@@ -4,24 +4,32 @@ ...@@ -4,24 +4,32 @@
# src/backend/utils/mb/Unicode/ucs2utf.pl # src/backend/utils/mb/Unicode/ucs2utf.pl
# convert UCS-4 to UTF-8 # convert UCS-4 to UTF-8
# #
sub ucs2utf { sub ucs2utf
local($ucs) = @_; {
local ($ucs) = @_;
local $utf; local $utf;
if ($ucs <= 0x007f) { if ($ucs <= 0x007f)
{
$utf = $ucs; $utf = $ucs;
} elsif ($ucs > 0x007f && $ucs <= 0x07ff) { }
elsif ($ucs > 0x007f && $ucs <= 0x07ff)
{
$utf = (($ucs & 0x003f) | 0x80) | ((($ucs >> 6) | 0xc0) << 8); $utf = (($ucs & 0x003f) | 0x80) | ((($ucs >> 6) | 0xc0) << 8);
} elsif ($ucs > 0x07ff && $ucs <= 0xffff) { }
$utf = ((($ucs >> 12) | 0xe0) << 16) | elsif ($ucs > 0x07ff && $ucs <= 0xffff)
(((($ucs & 0x0fc0) >> 6) | 0x80) << 8) | {
(($ucs & 0x003f) | 0x80); $utf =
} else { ((($ucs >> 12) | 0xe0) << 16) |
$utf = ((($ucs >> 18) | 0xf0) << 24) | (((($ucs & 0x0fc0) >> 6) | 0x80) << 8) | (($ucs & 0x003f) | 0x80);
(((($ucs & 0x3ffff) >> 12) | 0x80) << 16) | }
(((($ucs & 0x0fc0) >> 6) | 0x80) << 8) | else
(($ucs & 0x003f) | 0x80); {
} $utf =
return($utf); ((($ucs >> 18) | 0xf0) << 24) |
(((($ucs & 0x3ffff) >> 12) | 0x80) << 16) |
(((($ucs & 0x0fc0) >> 6) | 0x80) << 8) | (($ucs & 0x003f) | 0x80);
}
return ($utf);
} }
1; 1;
src/backend/utils/sort/gen_qsort_tuple.pl
View file @ 042d9ffc
...@@ -32,16 +32,16 @@ my $CMPPARAMS; ...@@ -32,16 +32,16 @@ my $CMPPARAMS;
emit_qsort_boilerplate(); emit_qsort_boilerplate();
$SUFFIX = 'tuple'; $SUFFIX = 'tuple';
$EXTRAARGS = ', SortTupleComparator cmp_tuple, Tuplesortstate *state'; $EXTRAARGS = ', SortTupleComparator cmp_tuple, Tuplesortstate *state';
$EXTRAPARAMS = ', cmp_tuple, state'; $EXTRAPARAMS = ', cmp_tuple, state';
$CMPPARAMS = ', state'; $CMPPARAMS = ', state';
emit_qsort_implementation(); emit_qsort_implementation();
$SUFFIX = 'ssup'; $SUFFIX = 'ssup';
$EXTRAARGS = ', SortSupport ssup'; $EXTRAARGS = ', SortSupport ssup';
$EXTRAPARAMS = ', ssup'; $EXTRAPARAMS = ', ssup';
$CMPPARAMS = ', ssup'; $CMPPARAMS = ', ssup';
print <<'EOM'; print <<'EOM';
#define cmp_ssup(a, b, ssup) \ #define cmp_ssup(a, b, ssup) \
ApplySortComparator((a)->datum1, (a)->isnull1, \ ApplySortComparator((a)->datum1, (a)->isnull1, \
......
src/bin/psql/create_help.pl
View file @ 042d9ffc
...@@ -22,15 +22,18 @@ ...@@ -22,15 +22,18 @@
use strict; use strict;
my $docdir = $ARGV[0] or die "$0: missing required argument: docdir\n"; my $docdir = $ARGV[0] or die "$0: missing required argument: docdir\n";
my $hfile = $ARGV[1] . '.h' or die "$0: missing required argument: output file\n"; my $hfile = $ARGV[1] . '.h'
or die "$0: missing required argument: output file\n";
my $cfile = $ARGV[1] . '.c'; my $cfile = $ARGV[1] . '.c';
my $hfilebasename; my $hfilebasename;
if ($hfile =~ m!.*/([^/]+)$!) { if ($hfile =~ m!.*/([^/]+)$!)
$hfilebasename = $1; {
$hfilebasename = $1;
} }
else { else
$hfilebasename = $hfile; {
$hfilebasename = $hfile;
} }
my $define = $hfilebasename; my $define = $hfilebasename;
...@@ -38,14 +41,13 @@ $define =~ tr/a-z/A-Z/; ...@@ -38,14 +41,13 @@ $define =~ tr/a-z/A-Z/;
$define =~ s/\W/_/g; $define =~ s/\W/_/g;
opendir(DIR, $docdir) opendir(DIR, $docdir)
or die "$0: could not open documentation source dir '$docdir': $!\n"; or die "$0: could not open documentation source dir '$docdir': $!\n";
open(HFILE, ">$hfile") open(HFILE, ">$hfile")
or die "$0: could not open output file '$hfile': $!\n"; or die "$0: could not open output file '$hfile': $!\n";
open(CFILE, ">$cfile") open(CFILE, ">$cfile")
or die "$0: could not open output file '$cfile': $!\n"; or die "$0: could not open output file '$cfile': $!\n";
print HFILE print HFILE "/*
"/*
* *** Do not change this file by hand. It is automatically * *** Do not change this file by hand. It is automatically
* *** generated from the DocBook documentation. * *** generated from the DocBook documentation.
* *
...@@ -72,8 +74,7 @@ struct _helpStruct ...@@ -72,8 +74,7 @@ struct _helpStruct
"; ";
print CFILE print CFILE "/*
"/*
* *** Do not change this file by hand. It is automatically * *** Do not change this file by hand. It is automatically
* *** generated from the DocBook documentation. * *** generated from the DocBook documentation.
* *
...@@ -90,71 +91,90 @@ my $maxlen = 0; ...@@ -90,71 +91,90 @@ my $maxlen = 0;
my %entries; my %entries;
foreach my $file (sort readdir DIR) { foreach my $file (sort readdir DIR)
my (@cmdnames, $cmddesc, $cmdsynopsis); {
$file =~ /\.sgml$/ or next; my (@cmdnames, $cmddesc, $cmdsynopsis);
$file =~ /\.sgml$/ or next;
open(FILE, "$docdir/$file") or next;
my $filecontent = join('', <FILE>); open(FILE, "$docdir/$file") or next;
close FILE; my $filecontent = join('', <FILE>);
close FILE;
# Ignore files that are not for SQL language statements
$filecontent =~ m!<refmiscinfo>\s*SQL - Language Statements\s*</refmiscinfo>!i # Ignore files that are not for SQL language statements
or next; $filecontent =~
m!<refmiscinfo>\s*SQL - Language Statements\s*</refmiscinfo>!i
# Collect multiple refnames or next;
LOOP: { $filecontent =~ m!\G.*?<refname>\s*([a-z ]+?)\s*</refname>!cgis and push @cmdnames, $1 and redo LOOP; }
$filecontent =~ m!<refpurpose>\s*(.+?)\s*</refpurpose>!is and $cmddesc = $1; # Collect multiple refnames
$filecontent =~ m!<synopsis>\s*(.+?)\s*</synopsis>!is and $cmdsynopsis = $1; LOOP:
{
if (@cmdnames && $cmddesc && $cmdsynopsis) { $filecontent =~ m!\G.*?<refname>\s*([a-z ]+?)\s*</refname>!cgis
s/\"/\\"/g foreach @cmdnames; and push @cmdnames, $1
and redo LOOP;
$cmddesc =~ s/<[^>]+>//g; }
$cmddesc =~ s/\s+/ /g; $filecontent =~ m!<refpurpose>\s*(.+?)\s*</refpurpose>!is
$cmddesc =~ s/\"/\\"/g; and $cmddesc = $1;
$filecontent =~ m!<synopsis>\s*(.+?)\s*</synopsis>!is
my @params = (); and $cmdsynopsis = $1;
my $nl_count = () = $cmdsynopsis =~ /\n/g; if (@cmdnames && $cmddesc && $cmdsynopsis)
{
$cmdsynopsis =~ m!</>! and die "$0:$file: null end tag not supported in synopsis\n"; s/\"/\\"/g foreach @cmdnames;
$cmdsynopsis =~ s/%/%%/g;
$cmddesc =~ s/<[^>]+>//g;
while ($cmdsynopsis =~ m!<(\w+)[^>]*>(.+?)</\1[^>]*>!) { $cmddesc =~ s/\s+/ /g;
my $match = $2; $cmddesc =~ s/\"/\\"/g;
$match =~ s/<[^>]+>//g;
$match =~ s/%%/%/g; my @params = ();
push @params, $match;
$cmdsynopsis =~ s!<(\w+)[^>]*>.+?</\1[^>]*>!%s!; my $nl_count = () = $cmdsynopsis =~ /\n/g;
}
$cmdsynopsis =~ s/\r?\n/\\n/g; $cmdsynopsis =~ m!</>!
$cmdsynopsis =~ s/\"/\\"/g; and die "$0:$file: null end tag not supported in synopsis\n";
$cmdsynopsis =~ s/%/%%/g;
foreach my $cmdname (@cmdnames) {
$entries{$cmdname} = { cmddesc => $cmddesc, cmdsynopsis => $cmdsynopsis, params => \@params, nl_count => $nl_count }; while ($cmdsynopsis =~ m!<(\w+)[^>]*>(.+?)</\1[^>]*>!)
$maxlen = ($maxlen >= length $cmdname) ? $maxlen : length $cmdname; {
my $match = $2;
$match =~ s/<[^>]+>//g;
$match =~ s/%%/%/g;
push @params, $match;
$cmdsynopsis =~ s!<(\w+)[^>]*>.+?</\1[^>]*>!%s!;
}
$cmdsynopsis =~ s/\r?\n/\\n/g;
$cmdsynopsis =~ s/\"/\\"/g;
foreach my $cmdname (@cmdnames)
{
$entries{$cmdname} = {
cmddesc => $cmddesc,
cmdsynopsis => $cmdsynopsis,
params => \@params,
nl_count => $nl_count };
$maxlen =
($maxlen >= length $cmdname) ? $maxlen : length $cmdname;
}
}
else
{
die "$0: parsing file '$file' failed (N='@cmdnames' D='$cmddesc')\n";
} }
}
else {
die "$0: parsing file '$file' failed (N='@cmdnames' D='$cmddesc')\n";
}
} }
foreach (sort keys %entries) { foreach (sort keys %entries)
my $prefix = "\t"x5 . ' '; {
my $id = $_; my $prefix = "\t" x 5 . ' ';
$id =~ s/ /_/g; my $id = $_;
my $synopsis = "\"$entries{$_}{cmdsynopsis}\""; $id =~ s/ /_/g;
$synopsis =~ s/\\n/\\n"\n$prefix"/g; my $synopsis = "\"$entries{$_}{cmdsynopsis}\"";
my @args = ("buf", $synopsis =~ s/\\n/\\n"\n$prefix"/g;
$synopsis, my @args =
map("_(\"$_\")", @{$entries{$_}{params}})); ("buf", $synopsis, map("_(\"$_\")", @{ $entries{$_}{params} }));
print HFILE "extern void sql_help_$id(PQExpBuffer buf);\n"; print HFILE "extern void sql_help_$id(PQExpBuffer buf);\n";
print CFILE "void print CFILE "void
sql_help_$id(PQExpBuffer buf) sql_help_$id(PQExpBuffer buf)
{ {
\tappendPQExpBuffer(".join(",\n$prefix", @args)."); \tappendPQExpBuffer(" . join(",\n$prefix", @args) . ");
} }
"; ";
...@@ -164,10 +184,11 @@ print HFILE " ...@@ -164,10 +184,11 @@ print HFILE "
static const struct _helpStruct QL_HELP[] = { static const struct _helpStruct QL_HELP[] = {
"; ";
foreach (sort keys %entries) { foreach (sort keys %entries)
my $id = $_; {
$id =~ s/ /_/g; my $id = $_;
print HFILE " { \"$_\", $id =~ s/ /_/g;
print HFILE " { \"$_\",
N_(\"$entries{$_}{cmddesc}\"), N_(\"$entries{$_}{cmddesc}\"),
sql_help_$id, sql_help_$id,
$entries{$_}{nl_count} }, $entries{$_}{nl_count} },
...@@ -180,7 +201,9 @@ print HFILE " ...@@ -180,7 +201,9 @@ print HFILE "
}; };
#define QL_HELP_COUNT ".scalar(keys %entries)." /* number of help items */ #define QL_HELP_COUNT "
. scalar(keys %entries)
. " /* number of help items */
#define QL_MAX_CMD_LEN $maxlen /* largest strlen(cmd) */ #define QL_MAX_CMD_LEN $maxlen /* largest strlen(cmd) */
......
src/interfaces/ecpg/preproc/check_rules.pl
View file @ 042d9ffc
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
# Copyright (c) 2009-2012, PostgreSQL Global Development Group # Copyright (c) 2009-2012, PostgreSQL Global Development Group
# #
# Written by Michael Meskes <meskes@postgresql.org> # Written by Michael Meskes <meskes@postgresql.org>
# Andy Colson <andy@squeakycode.net> # Andy Colson <andy@squeakycode.net>
# #
# Placed under the same license as PostgreSQL. # Placed under the same license as PostgreSQL.
# #
...@@ -25,7 +25,7 @@ if ($ARGV[0] eq '-v') ...@@ -25,7 +25,7 @@ if ($ARGV[0] eq '-v')
{ {
$verbose = shift; $verbose = shift;
} }
my $path = shift || '.'; my $path = shift || '.';
my $parser = shift || '../../../backend/parser/gram.y'; my $parser = shift || '../../../backend/parser/gram.y';
my $filename = $path . "/ecpg.addons"; my $filename = $path . "/ecpg.addons";
...@@ -37,32 +37,31 @@ if ($verbose) ...@@ -37,32 +37,31 @@ if ($verbose)
my %replace_line = ( my %replace_line = (
'ExecuteStmtEXECUTEnameexecute_param_clause' => 'ExecuteStmtEXECUTEnameexecute_param_clause' =>
'EXECUTE prepared_name execute_param_clause execute_rest', 'EXECUTE prepared_name execute_param_clause execute_rest',
'ExecuteStmtCREATEOptTempTABLEcreate_as_targetASEXECUTEnameexecute_param_clause' => 'ExecuteStmtCREATEOptTempTABLEcreate_as_targetASEXECUTEnameexecute_param_clause'
'CREATE OptTemp TABLE create_as_target AS EXECUTE prepared_name execute_param_clause', => 'CREATE OptTemp TABLE create_as_target AS EXECUTE prepared_name execute_param_clause',
'PrepareStmtPREPAREnameprep_type_clauseASPreparableStmt' => 'PrepareStmtPREPAREnameprep_type_clauseASPreparableStmt' =>
'PREPARE prepared_name prep_type_clause AS PreparableStmt' 'PREPARE prepared_name prep_type_clause AS PreparableStmt');
);
my $block = ''; my $block = '';
my $yaccmode = 0; my $yaccmode = 0;
my $brace_indent = 0; my $brace_indent = 0;
my (@arr, %found); my (@arr, %found);
my $comment = 0; my $comment = 0;
my $non_term_id = ''; my $non_term_id = '';
my $cc = 0; my $cc = 0;
open GRAM, $parser or die $!; open GRAM, $parser or die $!;
while (<GRAM>) while (<GRAM>)
{ {
if (/^%%/) if (/^%%/)
{ {
$yaccmode++; $yaccmode++;
} }
if ( $yaccmode != 1 ) if ($yaccmode != 1)
{ {
next; next;
} }
...@@ -80,50 +79,51 @@ while (<GRAM>) ...@@ -80,50 +79,51 @@ while (<GRAM>)
s|\*\/| */ |g; s|\*\/| */ |g;
# Now split the line into individual fields # Now split the line into individual fields
my $n = ( @arr = split( ' ' ) ); my $n = (@arr = split(' '));
# Go through each field in turn # Go through each field in turn
for ( my $fieldIndexer = 0 ; $fieldIndexer < $n ; $fieldIndexer++ ) for (my $fieldIndexer = 0; $fieldIndexer < $n; $fieldIndexer++)
{ {
if ( $arr[$fieldIndexer] eq '*/' && $comment ) if ($arr[$fieldIndexer] eq '*/' && $comment)
{ {
$comment = 0; $comment = 0;
next; next;
} }
elsif ($comment) elsif ($comment)
{ {
next; next;
} }
elsif ( $arr[$fieldIndexer] eq '/*' ) elsif ($arr[$fieldIndexer] eq '/*')
{ {
# start of a multiline comment # start of a multiline comment
$comment = 1; $comment = 1;
next; next;
} }
elsif ( $arr[$fieldIndexer] eq '//' ) elsif ($arr[$fieldIndexer] eq '//')
{ {
next; next;
} }
elsif ( $arr[$fieldIndexer] eq '}' ) elsif ($arr[$fieldIndexer] eq '}')
{ {
$brace_indent--; $brace_indent--;
next; next;
} }
elsif ( $arr[$fieldIndexer] eq '{' ) elsif ($arr[$fieldIndexer] eq '{')
{ {
$brace_indent++; $brace_indent++;
next; next;
} }
if ( $brace_indent > 0 ) if ($brace_indent > 0)
{ {
next; next;
} }
if ( $arr[$fieldIndexer] eq ';' || $arr[$fieldIndexer] eq '|' ) if ($arr[$fieldIndexer] eq ';' || $arr[$fieldIndexer] eq '|')
{ {
$block = $non_term_id . $block; $block = $non_term_id . $block;
if ( $replace_line{$block} ) if ($replace_line{$block})
{ {
$block = $non_term_id . $replace_line{$block}; $block = $non_term_id . $replace_line{$block};
$block =~ tr/ |//d; $block =~ tr/ |//d;
...@@ -132,13 +132,13 @@ while (<GRAM>) ...@@ -132,13 +132,13 @@ while (<GRAM>)
$cc++; $cc++;
$block = ''; $block = '';
} }
elsif ( ( $arr[$fieldIndexer] =~ '[A-Za-z0-9]+:' ) elsif (($arr[$fieldIndexer] =~ '[A-Za-z0-9]+:')
|| $arr[ $fieldIndexer + 1 ] eq ':' ) || $arr[ $fieldIndexer + 1 ] eq ':')
{ {
$non_term_id = $arr[$fieldIndexer]; $non_term_id = $arr[$fieldIndexer];
$non_term_id =~ tr/://d; $non_term_id =~ tr/://d;
} }
else else
{ {
$block = $block . $arr[$fieldIndexer]; $block = $block . $arr[$fieldIndexer];
} }
...@@ -155,16 +155,16 @@ my $ret = 0; ...@@ -155,16 +155,16 @@ my $ret = 0;
$cc = 0; $cc = 0;
open ECPG, $filename or die $!; open ECPG, $filename or die $!;
while (<ECPG>) while (<ECPG>)
{ {
if ( !/^ECPG:/ ) if (!/^ECPG:/)
{ {
next; next;
} }
my @Fld = split( ' ', $_, 3 ); my @Fld = split(' ', $_, 3);
$cc++; $cc++;
if ( not exists $found{ $Fld[1] } ) if (not exists $found{ $Fld[1] })
{ {
print $Fld[1], " is not used for building parser!\n"; print $Fld[1], " is not used for building parser!\n";
$ret = 1; $ret = 1;
......
src/interfaces/ecpg/preproc/parse.pl
View file @ 042d9ffc
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
# #
# Written by Mike Aubury <mike.aubury@aubit.com> # Written by Mike Aubury <mike.aubury@aubit.com>
# Michael Meskes <meskes@postgresql.org> # Michael Meskes <meskes@postgresql.org>
# Andy Colson <andy@squeakycode.net> # Andy Colson <andy@squeakycode.net>
# #
# Placed under the same license as PostgreSQL. # Placed under the same license as PostgreSQL.
# #
...@@ -26,9 +26,9 @@ my $header_included = 0; ...@@ -26,9 +26,9 @@ my $header_included = 0;
my $feature_not_supported = 0; my $feature_not_supported = 0;
my $tokenmode = 0; my $tokenmode = 0;
my(%buff, $infield, $comment, %tokens, %addons ); my (%buff, $infield, $comment, %tokens, %addons);
my($stmt_mode, @fields); my ($stmt_mode, @fields);
my($line, $non_term_id); my ($line, $non_term_id);
# some token have to be replaced by other symbols # some token have to be replaced by other symbols
...@@ -38,8 +38,7 @@ my %replace_token = ( ...@@ -38,8 +38,7 @@ my %replace_token = (
'FCONST' => 'ecpg_fconst', 'FCONST' => 'ecpg_fconst',
'Sconst' => 'ecpg_sconst', 'Sconst' => 'ecpg_sconst',
'IDENT' => 'ecpg_ident', 'IDENT' => 'ecpg_ident',
'PARAM' => 'ecpg_param', 'PARAM' => 'ecpg_param',);
);
# or in the block # or in the block
my %replace_string = ( my %replace_string = (
...@@ -48,8 +47,7 @@ my %replace_string = ( ...@@ -48,8 +47,7 @@ my %replace_string = (
'NULLS_LAST' => 'nulls last', 'NULLS_LAST' => 'nulls last',
'TYPECAST' => '::', 'TYPECAST' => '::',
'DOT_DOT' => '..', 'DOT_DOT' => '..',
'COLON_EQUALS' => ':=', 'COLON_EQUALS' => ':=',);
);
# specific replace_types for specific non-terminals - never include the ':' # specific replace_types for specific non-terminals - never include the ':'
# ECPG-only replace_types are defined in ecpg-replace_types # ECPG-only replace_types are defined in ecpg-replace_types
...@@ -65,8 +63,7 @@ my %replace_types = ( ...@@ -65,8 +63,7 @@ my %replace_types = (
'ColId' => 'ignore', 'ColId' => 'ignore',
'type_function_name' => 'ignore', 'type_function_name' => 'ignore',
'ColLabel' => 'ignore', 'ColLabel' => 'ignore',
'Sconst' => 'ignore', 'Sconst' => 'ignore',);
);
# these replace_line commands excise certain keywords from the core keyword # these replace_line commands excise certain keywords from the core keyword
# lists. Be sure to account for these in ColLabel and related productions. # lists. Be sure to account for these in ColLabel and related productions.
...@@ -90,18 +87,21 @@ my %replace_line = ( ...@@ -90,18 +87,21 @@ my %replace_line = (
'fetch_argsFORWARDopt_from_incursor_name' => 'ignore', 'fetch_argsFORWARDopt_from_incursor_name' => 'ignore',
'fetch_argsBACKWARDopt_from_incursor_name' => 'ignore', 'fetch_argsBACKWARDopt_from_incursor_name' => 'ignore',
"opt_array_boundsopt_array_bounds'['Iconst']'" => 'ignore', "opt_array_boundsopt_array_bounds'['Iconst']'" => 'ignore',
'VariableShowStmtSHOWvar_name' => 'SHOW var_name ecpg_into', 'VariableShowStmtSHOWvar_name' => 'SHOW var_name ecpg_into',
'VariableShowStmtSHOWTIMEZONE' => 'SHOW TIME ZONE ecpg_into', 'VariableShowStmtSHOWTIMEZONE' => 'SHOW TIME ZONE ecpg_into',
'VariableShowStmtSHOWTRANSACTIONISOLATIONLEVEL' => 'SHOW TRANSACTION ISOLATION LEVEL ecpg_into', 'VariableShowStmtSHOWTRANSACTIONISOLATIONLEVEL' =>
'VariableShowStmtSHOWSESSIONAUTHORIZATION' => 'SHOW SESSION AUTHORIZATION ecpg_into', 'SHOW TRANSACTION ISOLATION LEVEL ecpg_into',
'returning_clauseRETURNINGtarget_list' => 'RETURNING target_list ecpg_into', 'VariableShowStmtSHOWSESSIONAUTHORIZATION' =>
'ExecuteStmtEXECUTEnameexecute_param_clause' => 'EXECUTE prepared_name execute_param_clause execute_rest', 'SHOW SESSION AUTHORIZATION ecpg_into',
'ExecuteStmtCREATEOptTempTABLEcreate_as_targetASEXECUTEnameexecute_param_clause' => 'returning_clauseRETURNINGtarget_list' =>
'CREATE OptTemp TABLE create_as_target AS EXECUTE prepared_name execute_param_clause', 'RETURNING target_list ecpg_into',
'PrepareStmtPREPAREnameprep_type_clauseASPreparableStmt' => 'ExecuteStmtEXECUTEnameexecute_param_clause' =>
'PREPARE prepared_name prep_type_clause AS PreparableStmt', 'EXECUTE prepared_name execute_param_clause execute_rest',
'var_nameColId' => 'ECPGColId', 'ExecuteStmtCREATEOptTempTABLEcreate_as_targetASEXECUTEnameexecute_param_clause'
); => 'CREATE OptTemp TABLE create_as_target AS EXECUTE prepared_name execute_param_clause',
'PrepareStmtPREPAREnameprep_type_clauseASPreparableStmt' =>
'PREPARE prepared_name prep_type_clause AS PreparableStmt',
'var_nameColId' => 'ECPGColId',);
preload_addons(); preload_addons();
...@@ -112,44 +112,45 @@ dump_buffer('tokens'); ...@@ -112,44 +112,45 @@ dump_buffer('tokens');
dump_buffer('types'); dump_buffer('types');
dump_buffer('ecpgtype'); dump_buffer('ecpgtype');
dump_buffer('orig_tokens'); dump_buffer('orig_tokens');
print '%%', "\n"; print '%%', "\n";
print 'prog: statements;', "\n"; print 'prog: statements;', "\n";
dump_buffer('rules'); dump_buffer('rules');
include_file( 'trailer', 'ecpg.trailer' ); include_file('trailer', 'ecpg.trailer');
dump_buffer('trailer'); dump_buffer('trailer');
sub main sub main
{ {
line: while (<>) line: while (<>)
{ {
if (/ERRCODE_FEATURE_NOT_SUPPORTED/) if (/ERRCODE_FEATURE_NOT_SUPPORTED/)
{ {
$feature_not_supported = 1; $feature_not_supported = 1;
next line; next line;
} }
chomp; chomp;
# comment out the line below to make the result file match (blank line wise) # comment out the line below to make the result file match (blank line wise)
# the prior version. # the prior version.
#next if ($_ eq ''); #next if ($_ eq '');
# Dump the action for a rule - # Dump the action for a rule -
# stmt_mode indicates if we are processing the 'stmt:' # stmt_mode indicates if we are processing the 'stmt:'
# rule (mode==0 means normal, mode==1 means stmt:) # rule (mode==0 means normal, mode==1 means stmt:)
# flds are the fields to use. These may start with a '$' - in # flds are the fields to use. These may start with a '$' - in
# which case they are the result of a previous non-terminal # which case they are the result of a previous non-terminal
# #
# if they dont start with a '$' then they are token name # if they dont start with a '$' then they are token name
# #
# len is the number of fields in flds... # len is the number of fields in flds...
# leadin is the padding to apply at the beginning (just use for formatting) # leadin is the padding to apply at the beginning (just use for formatting)
if (/^%%/) { if (/^%%/)
{
$tokenmode = 2; $tokenmode = 2;
$copymode = 1; $copymode = 1;
$yaccmode++; $yaccmode++;
$infield = 0; $infield = 0;
} }
my $prec = 0; my $prec = 0;
...@@ -165,130 +166,136 @@ sub main ...@@ -165,130 +166,136 @@ sub main
# Now split the line into individual fields # Now split the line into individual fields
my @arr = split(' '); my @arr = split(' ');
if ( $arr[0] eq '%token' && $tokenmode == 0 ) if ($arr[0] eq '%token' && $tokenmode == 0)
{ {
$tokenmode = 1; $tokenmode = 1;
include_file( 'tokens', 'ecpg.tokens' ); include_file('tokens', 'ecpg.tokens');
} }
elsif ( $arr[0] eq '%type' && $header_included == 0 ) elsif ($arr[0] eq '%type' && $header_included == 0)
{ {
include_file( 'header', 'ecpg.header' ); include_file('header', 'ecpg.header');
include_file( 'ecpgtype', 'ecpg.type' ); include_file('ecpgtype', 'ecpg.type');
$header_included = 1; $header_included = 1;
} }
if ( $tokenmode == 1 ) if ($tokenmode == 1)
{ {
my $str = ''; my $str = '';
my $prior = ''; my $prior = '';
for my $a (@arr) for my $a (@arr)
{ {
if ( $a eq '/*' ) if ($a eq '/*')
{ {
$comment++; $comment++;
next; next;
} }
if ( $a eq '*/' ) if ($a eq '*/')
{ {
$comment--; $comment--;
next; next;
} }
if ($comment) if ($comment)
{ {
next; next;
} }
if ( substr( $a, 0, 1 ) eq '<' ) { if (substr($a, 0, 1) eq '<')
{
next; next;
# its a type # its a type
} }
$tokens{ $a } = 1; $tokens{$a} = 1;
$str = $str . ' ' . $a; $str = $str . ' ' . $a;
if ( $a eq 'IDENT' && $prior eq '%nonassoc' ) if ($a eq 'IDENT' && $prior eq '%nonassoc')
{ {
# add two more tokens to the list # add two more tokens to the list
$str = $str . "\n%nonassoc CSTRING\n%nonassoc UIDENT"; $str = $str . "\n%nonassoc CSTRING\n%nonassoc UIDENT";
} }
$prior = $a; $prior = $a;
} }
add_to_buffer( 'orig_tokens', $str ); add_to_buffer('orig_tokens', $str);
next line; next line;
} }
# Dont worry about anything if we're not in the right section of gram.y # Dont worry about anything if we're not in the right section of gram.y
if ( $yaccmode != 1 ) if ($yaccmode != 1)
{ {
next line; next line;
} }
# Go through each field in turn # Go through each field in turn
for (my $fieldIndexer = 0 ; $fieldIndexer < scalar(@arr) ; $fieldIndexer++ ) for (
my $fieldIndexer = 0;
$fieldIndexer < scalar(@arr);
$fieldIndexer++)
{ {
if ( $arr[$fieldIndexer] eq '*/' && $comment ) if ($arr[$fieldIndexer] eq '*/' && $comment)
{ {
$comment = 0; $comment = 0;
next; next;
} }
elsif ($comment) elsif ($comment)
{ {
next; next;
} }
elsif ( $arr[$fieldIndexer] eq '/*' ) elsif ($arr[$fieldIndexer] eq '/*')
{ {
# start of a multiline comment # start of a multiline comment
$comment = 1; $comment = 1;
next; next;
} }
elsif ( $arr[$fieldIndexer] eq '//' ) elsif ($arr[$fieldIndexer] eq '//')
{ {
next line; next line;
} }
elsif ( $arr[$fieldIndexer] eq '}' ) elsif ($arr[$fieldIndexer] eq '}')
{ {
$brace_indent--; $brace_indent--;
next; next;
} }
elsif ( $arr[$fieldIndexer] eq '{' ) elsif ($arr[$fieldIndexer] eq '{')
{ {
$brace_indent++; $brace_indent++;
next; next;
} }
if ( $brace_indent > 0 ) if ($brace_indent > 0)
{ {
next; next;
} }
if ( $arr[$fieldIndexer] eq ';' ) if ($arr[$fieldIndexer] eq ';')
{ {
if ($copymode) if ($copymode)
{ {
if ( $infield ) if ($infield)
{ {
dump_line( $stmt_mode, \@fields ); dump_line($stmt_mode, \@fields);
} }
add_to_buffer( 'rules', ";\n\n" ); add_to_buffer('rules', ";\n\n");
} }
else else
{ {
$copymode = 1; $copymode = 1;
} }
@fields = (); @fields = ();
$infield = 0; $infield = 0;
$line = ''; $line = '';
next; next;
} }
if ( $arr[$fieldIndexer] eq '|' ) if ($arr[$fieldIndexer] eq '|')
{ {
if ($copymode) if ($copymode)
{ {
if ( $infield ) if ($infield)
{ {
$infield = $infield + dump_line( $stmt_mode, \@fields ); $infield = $infield + dump_line($stmt_mode, \@fields);
} }
if ( $infield > 1 ) if ($infield > 1)
{ {
$line = '| '; $line = '| ';
} }
...@@ -297,24 +304,24 @@ sub main ...@@ -297,24 +304,24 @@ sub main
next; next;
} }
if ( exists $replace_token{ $arr[$fieldIndexer] } ) if (exists $replace_token{ $arr[$fieldIndexer] })
{ {
$arr[$fieldIndexer] = $replace_token{ $arr[$fieldIndexer] }; $arr[$fieldIndexer] = $replace_token{ $arr[$fieldIndexer] };
} }
# Are we looking at a declaration of a non-terminal ? # Are we looking at a declaration of a non-terminal ?
if ( ( $arr[$fieldIndexer] =~ /[A-Za-z0-9]+:/ ) if (($arr[$fieldIndexer] =~ /[A-Za-z0-9]+:/)
|| $arr[ $fieldIndexer + 1 ] eq ':' ) || $arr[ $fieldIndexer + 1 ] eq ':')
{ {
$non_term_id = $arr[$fieldIndexer]; $non_term_id = $arr[$fieldIndexer];
$non_term_id =~ tr/://d; $non_term_id =~ tr/://d;
if ( not defined $replace_types{$non_term_id} ) if (not defined $replace_types{$non_term_id})
{ {
$replace_types{$non_term_id} = '<str>'; $replace_types{$non_term_id} = '<str>';
$copymode = 1; $copymode = 1;
} }
elsif ( $replace_types{$non_term_id} eq 'ignore' ) elsif ($replace_types{$non_term_id} eq 'ignore')
{ {
$copymode = 0; $copymode = 0;
$line = ''; $line = '';
...@@ -324,38 +331,43 @@ sub main ...@@ -324,38 +331,43 @@ sub main
# Do we have the : attached already ? # Do we have the : attached already ?
# If yes, we'll have already printed the ':' # If yes, we'll have already printed the ':'
if ( !( $arr[$fieldIndexer] =~ '[A-Za-z0-9]+:' ) ) if (!($arr[$fieldIndexer] =~ '[A-Za-z0-9]+:'))
{ {
# Consume the ':' which is next... # Consume the ':' which is next...
$line = $line . ':'; $line = $line . ':';
$fieldIndexer++; $fieldIndexer++;
} }
# Special mode? # Special mode?
if ( $non_term_id eq 'stmt' ) if ($non_term_id eq 'stmt')
{ {
$stmt_mode = 1; $stmt_mode = 1;
} }
else else
{ {
$stmt_mode = 0; $stmt_mode = 0;
} }
my $tstr = '%type ' . $replace_types{$non_term_id} . ' ' . $non_term_id; my $tstr =
add_to_buffer( 'types', $tstr ); '%type '
. $replace_types{$non_term_id} . ' '
. $non_term_id;
add_to_buffer('types', $tstr);
if ($copymode) if ($copymode)
{ {
add_to_buffer( 'rules', $line ); add_to_buffer('rules', $line);
} }
$line = ''; $line = '';
@fields = (); @fields = ();
$infield = 1; $infield = 1;
next; next;
} }
elsif ($copymode) { elsif ($copymode)
{
$line = $line . ' ' . $arr[$fieldIndexer]; $line = $line . ' ' . $arr[$fieldIndexer];
} }
if ( $arr[$fieldIndexer] eq '%prec' ) if ($arr[$fieldIndexer] eq '%prec')
{ {
$prec = 1; $prec = 1;
next; next;
...@@ -364,38 +376,37 @@ sub main ...@@ -364,38 +376,37 @@ sub main
if ( $copymode if ( $copymode
&& !$prec && !$prec
&& !$comment && !$comment
&& length( $arr[$fieldIndexer] ) && length($arr[$fieldIndexer])
&& $infield ) && $infield)
{ {
if ( if ($arr[$fieldIndexer] ne 'Op'
$arr[$fieldIndexer] ne 'Op' && ( $tokens{ $arr[$fieldIndexer] } > 0
&& ( $tokens{ $arr[$fieldIndexer] } > 0 || $arr[$fieldIndexer] =~ /'.+'/ ) || $arr[$fieldIndexer] =~ /'.+'/)
|| $stmt_mode == 1 || $stmt_mode == 1)
)
{ {
my $S; my $S;
if ( exists $replace_string{ $arr[$fieldIndexer] } ) if (exists $replace_string{ $arr[$fieldIndexer] })
{ {
$S = $replace_string{ $arr[$fieldIndexer] }; $S = $replace_string{ $arr[$fieldIndexer] };
} }
else else
{ {
$S = $arr[$fieldIndexer]; $S = $arr[$fieldIndexer];
} }
$S =~ s/_P//g; $S =~ s/_P//g;
$S =~ tr/'//d; $S =~ tr/'//d;
if ( $stmt_mode == 1 ) if ($stmt_mode == 1)
{ {
push(@fields, $S); push(@fields, $S);
} }
else else
{ {
push(@fields, lc($S)); push(@fields, lc($S));
} }
} }
else else
{ {
push(@fields, '$' . (scalar(@fields)+1)); push(@fields, '$' . (scalar(@fields) + 1));
} }
} }
} }
...@@ -405,43 +416,43 @@ sub main ...@@ -405,43 +416,43 @@ sub main
# append a file onto a buffer. # append a file onto a buffer.
# Arguments: buffer_name, filename (without path) # Arguments: buffer_name, filename (without path)
sub include_file sub include_file
{ {
my ($buffer, $filename) = @_; my ($buffer, $filename) = @_;
my $full = "$path/$filename"; my $full = "$path/$filename";
open(my $fh, '<', $full) or die; open(my $fh, '<', $full) or die;
while ( <$fh> ) while (<$fh>)
{ {
chomp; chomp;
add_to_buffer( $buffer, $_ ); add_to_buffer($buffer, $_);
} }
close($fh); close($fh);
} }
sub include_addon sub include_addon
{ {
my($buffer, $block, $fields, $stmt_mode) = @_; my ($buffer, $block, $fields, $stmt_mode) = @_;
my $rec = $addons{$block}; my $rec = $addons{$block};
return 0 unless $rec; return 0 unless $rec;
if ( $rec->{type} eq 'rule' ) if ($rec->{type} eq 'rule')
{ {
dump_fields( $stmt_mode, $fields, ' { ' ); dump_fields($stmt_mode, $fields, ' { ');
} }
elsif ( $rec->{type} eq 'addon' ) elsif ($rec->{type} eq 'addon')
{ {
add_to_buffer( 'rules', ' { ' ); add_to_buffer('rules', ' { ');
} }
#add_to_buffer( $stream, $_ ); #add_to_buffer( $stream, $_ );
#We have an array to add to the buffer, we'll add it ourself instead of #We have an array to add to the buffer, we'll add it ourself instead of
#calling add_to_buffer, which does not know about arrays #calling add_to_buffer, which does not know about arrays
push( @{ $buff{$buffer} }, @{ $rec->{lines} } );
if ( $rec->{type} eq 'addon' ) push(@{ $buff{$buffer} }, @{ $rec->{lines} });
if ($rec->{type} eq 'addon')
{ {
dump_fields( $stmt_mode, $fields, '' ); dump_fields($stmt_mode, $fields, '');
} }
...@@ -454,56 +465,60 @@ sub include_addon ...@@ -454,56 +465,60 @@ sub include_addon
# include_addon does this same thing, but does not call this # include_addon does this same thing, but does not call this
# sub... so if you change this, you need to fix include_addon too # sub... so if you change this, you need to fix include_addon too
# Pass: buffer_name, string_to_append # Pass: buffer_name, string_to_append
sub add_to_buffer sub add_to_buffer
{ {
push( @{ $buff{$_[0]} }, "$_[1]\n" ); push(@{ $buff{ $_[0] } }, "$_[1]\n");
} }
sub dump_buffer sub dump_buffer
{ {
my($buffer) = @_; my ($buffer) = @_;
print '/* ', $buffer, ' */',"\n"; print '/* ', $buffer, ' */', "\n";
my $ref = $buff{$buffer}; my $ref = $buff{$buffer};
print @$ref; print @$ref;
} }
sub dump_fields sub dump_fields
{ {
my ( $mode, $flds, $ln ) = @_; my ($mode, $flds, $ln) = @_;
my $len = scalar(@$flds); my $len = scalar(@$flds);
if ( $mode == 0 ) if ($mode == 0)
{ {
#Normal #Normal
add_to_buffer( 'rules', $ln ); add_to_buffer('rules', $ln);
if ( $feature_not_supported == 1 ) if ($feature_not_supported == 1)
{ {
# we found an unsupported feature, but we have to # we found an unsupported feature, but we have to
# filter out ExecuteStmt: CREATE OptTemp TABLE ... # filter out ExecuteStmt: CREATE OptTemp TABLE ...
# because the warning there is only valid in some situations # because the warning there is only valid in some situations
if ( $flds->[0] ne 'create' || $flds->[2] ne 'table' ) if ($flds->[0] ne 'create' || $flds->[2] ne 'table')
{ {
add_to_buffer( 'rules', add_to_buffer('rules',
'mmerror(PARSE_ERROR, ET_WARNING, "unsupported feature will be passed to server");' 'mmerror(PARSE_ERROR, ET_WARNING, "unsupported feature will be passed to server");'
); );
} }
$feature_not_supported = 0; $feature_not_supported = 0;
} }
if ( $len == 0 ) if ($len == 0)
{ {
# We have no fields ? # We have no fields ?
add_to_buffer( 'rules', ' $$=EMPTY; }' ); add_to_buffer('rules', ' $$=EMPTY; }');
} }
else else
{ {
# Go through each field and try to 'aggregate' the tokens
# Go through each field and try to 'aggregate' the tokens
# into a single 'mm_strdup' where possible # into a single 'mm_strdup' where possible
my @flds_new; my @flds_new;
my $str; my $str;
for ( my $z = 0 ; $z < $len ; $z++ ) for (my $z = 0; $z < $len; $z++)
{ {
if ( substr( $flds->[$z], 0, 1 ) eq '$' ) if (substr($flds->[$z], 0, 1) eq '$')
{ {
push(@flds_new, $flds->[$z]); push(@flds_new, $flds->[$z]);
next; next;
...@@ -511,12 +526,14 @@ sub dump_fields ...@@ -511,12 +526,14 @@ sub dump_fields
$str = $flds->[$z]; $str = $flds->[$z];
while (1) while (1)
{ {
if ( $z >= $len - 1 || substr( $flds->[ $z + 1 ], 0, 1 ) eq '$' ) if ($z >= $len - 1
|| substr($flds->[ $z + 1 ], 0, 1) eq '$')
{ {
# We're at the end... # We're at the end...
push(@flds_new, "mm_strdup(\"$str\")"); push(@flds_new, "mm_strdup(\"$str\")");
last; last;
} }
$z++; $z++;
...@@ -526,67 +543,73 @@ sub dump_fields ...@@ -526,67 +543,73 @@ sub dump_fields
# So - how many fields did we end up with ? # So - how many fields did we end up with ?
$len = scalar(@flds_new); $len = scalar(@flds_new);
if ( $len == 1 ) if ($len == 1)
{ {
# Straight assignement # Straight assignement
$str = ' $$ = ' . $flds_new[0] . ';'; $str = ' $$ = ' . $flds_new[0] . ';';
add_to_buffer( 'rules', $str ); add_to_buffer('rules', $str);
} }
else else
{ {
# Need to concatenate the results to form # Need to concatenate the results to form
# our final string # our final string
$str = ' $$ = cat_str(' . $len . ',' . join(',', @flds_new) . ');'; $str =
add_to_buffer( 'rules', $str ); ' $$ = cat_str(' . $len . ',' . join(',', @flds_new) . ');';
add_to_buffer('rules', $str);
} }
add_to_buffer( 'rules', '}' ); add_to_buffer('rules', '}');
} }
} }
else else
{ {
# we're in the stmt: rule # we're in the stmt: rule
if ($len) if ($len)
{ {
# or just the statement ... # or just the statement ...
add_to_buffer( 'rules', ' { output_statement($1, 0, ECPGst_normal); }' ); add_to_buffer('rules',
' { output_statement($1, 0, ECPGst_normal); }');
} }
else else
{ {
add_to_buffer( 'rules', ' { $$ = NULL; }' ); add_to_buffer('rules', ' { $$ = NULL; }');
} }
} }
} }
sub dump_line sub dump_line
{ {
my($stmt_mode, $fields) = @_; my ($stmt_mode, $fields) = @_;
my $block = $non_term_id . $line; my $block = $non_term_id . $line;
$block =~ tr/ |//d; $block =~ tr/ |//d;
my $rep = $replace_line{$block}; my $rep = $replace_line{$block};
if ($rep) if ($rep)
{ {
if ($rep eq 'ignore' ) if ($rep eq 'ignore')
{ {
return 0; return 0;
} }
if ( index( $line, '|' ) != -1 ) if (index($line, '|') != -1)
{ {
$line = '| ' . $rep; $line = '| ' . $rep;
} }
else else
{ {
$line = $rep; $line = $rep;
} }
$block = $non_term_id . $line; $block = $non_term_id . $line;
$block =~ tr/ |//d; $block =~ tr/ |//d;
} }
add_to_buffer( 'rules', $line ); add_to_buffer('rules', $line);
my $i = include_addon( 'rules', $block, $fields, $stmt_mode); my $i = include_addon('rules', $block, $fields, $stmt_mode);
if ( $i == 0 ) if ($i == 0)
{ {
dump_fields( $stmt_mode, $fields, ' { ' ); dump_fields($stmt_mode, $fields, ' { ');
} }
return 1; return 1;
} }
...@@ -599,16 +622,19 @@ sub dump_line ...@@ -599,16 +622,19 @@ sub dump_line
} }
=cut =cut
sub preload_addons sub preload_addons
{ {
my $filename = $path . "/ecpg.addons"; my $filename = $path . "/ecpg.addons";
open(my $fh, '<', $filename) or die; open(my $fh, '<', $filename) or die;
# there may be multple lines starting ECPG: and then multiple lines of code.
# the code need to be add to all prior ECPG records. # there may be multple lines starting ECPG: and then multiple lines of code.
# the code need to be add to all prior ECPG records.
my (@needsRules, @code, $record); my (@needsRules, @code, $record);
# there may be comments before the first ECPG line, skip them # there may be comments before the first ECPG line, skip them
my $skip = 1; my $skip = 1;
while ( <$fh> ) while (<$fh>)
{ {
if (/^ECPG:\s(\S+)\s?(\w+)?/) if (/^ECPG:\s(\S+)\s?(\w+)?/)
{ {
...@@ -619,16 +645,16 @@ sub preload_addons ...@@ -619,16 +645,16 @@ sub preload_addons
{ {
push(@{ $x->{lines} }, @code); push(@{ $x->{lines} }, @code);
} }
@code = (); @code = ();
@needsRules = (); @needsRules = ();
} }
$record = {}; $record = {};
$record->{type} = $2; $record->{type} = $2;
$record->{lines} = []; $record->{lines} = [];
if (exists $addons{$1}) { die "Ga! there are dups!\n"; } if (exists $addons{$1}) { die "Ga! there are dups!\n"; }
$addons{$1} = $record; $addons{$1} = $record;
push(@needsRules, $record); push(@needsRules, $record);
} }
else else
{ {
next if $skip; next if $skip;
......
src/pl/plperl/plc_perlboot.pl
View file @ 042d9ffc
...@@ -7,99 +7,113 @@ PostgreSQL::InServer::Util::bootstrap(); ...@@ -7,99 +7,113 @@ PostgreSQL::InServer::Util::bootstrap();
# globals # globals
sub ::is_array_ref { sub ::is_array_ref
{
return ref($_[0]) =~ m/^(?:PostgreSQL::InServer::)?ARRAY$/; return ref($_[0]) =~ m/^(?:PostgreSQL::InServer::)?ARRAY$/;
} }
sub ::encode_array_literal { sub ::encode_array_literal
{
my ($arg, $delim) = @_; my ($arg, $delim) = @_;
return $arg unless(::is_array_ref($arg)); return $arg unless (::is_array_ref($arg));
$delim = ', ' unless defined $delim; $delim = ', ' unless defined $delim;
my $res = ''; my $res = '';
foreach my $elem (@$arg) { foreach my $elem (@$arg)
{
$res .= $delim if length $res; $res .= $delim if length $res;
if (ref $elem) { if (ref $elem)
{
$res .= ::encode_array_literal($elem, $delim); $res .= ::encode_array_literal($elem, $delim);
} }
elsif (defined $elem) { elsif (defined $elem)
{
(my $str = $elem) =~ s/(["\\])/\\$1/g; (my $str = $elem) =~ s/(["\\])/\\$1/g;
$res .= qq("$str"); $res .= qq("$str");
} }
else { else
{
$res .= 'NULL'; $res .= 'NULL';
} }
} }
return qq({$res}); return qq({$res});
} }
sub ::encode_array_constructor { sub ::encode_array_constructor
{
my $arg = shift; my $arg = shift;
return ::quote_nullable($arg) unless ::is_array_ref($arg); return ::quote_nullable($arg) unless ::is_array_ref($arg);
my $res = join ", ", map { my $res = join ", ",
(ref $_) ? ::encode_array_constructor($_) map { (ref $_) ? ::encode_array_constructor($_) : ::quote_nullable($_) }
: ::quote_nullable($_) @$arg;
} @$arg;
return "ARRAY[$res]"; return "ARRAY[$res]";
} }
{ {
package PostgreSQL::InServer;
use strict;
use warnings;
sub plperl_warn {
(my $msg = shift) =~ s/\(eval \d+\) //g;
chomp $msg;
&::elog(&::WARNING, $msg);
}
$SIG{__WARN__} = \&plperl_warn;
sub plperl_die { package PostgreSQL::InServer;
(my $msg = shift) =~ s/\(eval \d+\) //g; use strict;
die $msg; use warnings;
}
$SIG{__DIE__} = \&plperl_die;
sub mkfuncsrc { sub plperl_warn
my ($name, $imports, $prolog, $src) = @_; {
(my $msg = shift) =~ s/\(eval \d+\) //g;
chomp $msg;
&::elog(&::WARNING, $msg);
}
$SIG{__WARN__} = \&plperl_warn;
my $BEGIN = join "\n", map { sub plperl_die
my $names = $imports->{$_} || []; {
"$_->import(qw(@$names));" (my $msg = shift) =~ s/\(eval \d+\) //g;
} sort keys %$imports; die $msg;
$BEGIN &&= "BEGIN { $BEGIN }"; }
$SIG{__DIE__} = \&plperl_die;
return qq[ package main; sub { $BEGIN $prolog $src } ]; sub mkfuncsrc
} {
my ($name, $imports, $prolog, $src) = @_;
sub mkfunc { my $BEGIN = join "\n", map {
no strict; # default to no strict for the eval my $names = $imports->{$_} || [];
no warnings; # default to no warnings for the eval "$_->import(qw(@$names));"
my $ret = eval(mkfuncsrc(@_)); } sort keys %$imports;
$@ =~ s/\(eval \d+\) //g if $@; $BEGIN &&= "BEGIN { $BEGIN }";
return $ret;
}
1; return qq[ package main; sub { $BEGIN $prolog $src } ];
}
sub mkfunc
{
no strict; # default to no strict for the eval
no warnings; # default to no warnings for the eval
my $ret = eval(mkfuncsrc(@_));
$@ =~ s/\(eval \d+\) //g if $@;
return $ret;
}
1;
} }
{ {
package PostgreSQL::InServer::ARRAY;
use strict;
use warnings;
use overload package PostgreSQL::InServer::ARRAY;
'""'=>\&to_str, use strict;
'@{}'=>\&to_arr; use warnings;
sub to_str { use overload
my $self = shift; '""' => \&to_str,
return ::encode_typed_literal($self->{'array'}, $self->{'typeoid'}); '@{}' => \&to_arr;
}
sub to_arr { sub to_str
return shift->{'array'}; {
} my $self = shift;
return ::encode_typed_literal($self->{'array'}, $self->{'typeoid'});
}
sub to_arr
{
return shift->{'array'};
}
1; 1;
} }
src/pl/plperl/plperl_opmask.pl
View file @ 042d9ffc
...@@ -5,54 +5,59 @@ use warnings; ...@@ -5,54 +5,59 @@ use warnings;
use Opcode qw(opset opset_to_ops opdesc); use Opcode qw(opset opset_to_ops opdesc);
my $plperl_opmask_h = shift my $plperl_opmask_h = shift
or die "Usage: $0 <output_filename.h>\n"; or die "Usage: $0 <output_filename.h>\n";
my $plperl_opmask_tmp = $plperl_opmask_h."tmp"; my $plperl_opmask_tmp = $plperl_opmask_h . "tmp";
END { unlink $plperl_opmask_tmp } END { unlink $plperl_opmask_tmp }
open my $fh, ">", "$plperl_opmask_tmp" open my $fh, ">", "$plperl_opmask_tmp"
or die "Could not write to $plperl_opmask_tmp: $!"; or die "Could not write to $plperl_opmask_tmp: $!";
printf $fh "#define PLPERL_SET_OPMASK(opmask) \\\n"; printf $fh "#define PLPERL_SET_OPMASK(opmask) \\\n";
printf $fh " memset(opmask, 1, MAXO);\t/* disable all */ \\\n"; printf $fh " memset(opmask, 1, MAXO);\t/* disable all */ \\\n";
printf $fh " /* then allow some... */ \\\n"; printf $fh " /* then allow some... */ \\\n";
my @allowed_ops = ( my @allowed_ops = (
# basic set of opcodes # basic set of opcodes
qw[:default :base_math !:base_io sort time], qw[:default :base_math !:base_io sort time],
# require is safe because we redirect the opcode # require is safe because we redirect the opcode
# entereval is safe as the opmask is now permanently set # entereval is safe as the opmask is now permanently set
# caller is safe because the entire interpreter is locked down # caller is safe because the entire interpreter is locked down
qw[require entereval caller], qw[require entereval caller],
# These are needed for utf8_heavy.pl: # These are needed for utf8_heavy.pl:
# dofile is safe because we redirect the opcode like require above # dofile is safe because we redirect the opcode like require above
# print is safe because the only writable filehandles are STDOUT & STDERR # print is safe because the only writable filehandles are STDOUT & STDERR
# prtf (printf) is safe as it's the same as print + sprintf # prtf (printf) is safe as it's the same as print + sprintf
qw[dofile print prtf], qw[dofile print prtf],
# Disallow these opcodes that are in the :base_orig optag # Disallow these opcodes that are in the :base_orig optag
# (included in :default) but aren't considered sufficiently safe # (included in :default) but aren't considered sufficiently safe
qw[!dbmopen !setpgrp !setpriority], qw[!dbmopen !setpgrp !setpriority],
# custom is not deemed a likely security risk as it can't be generated from
# perl so would only be seen if the DBA had chosen to load a module that # custom is not deemed a likely security risk as it can't be generated from
# used it. Even then it's unlikely to be seen because it's typically # perl so would only be seen if the DBA had chosen to load a module that
# generated by compiler plugins that operate after PL_op_mask checks. # used it. Even then it's unlikely to be seen because it's typically
# But we err on the side of caution and disable it # generated by compiler plugins that operate after PL_op_mask checks.
qw[!custom], # But we err on the side of caution and disable it
); qw[!custom],);
printf $fh " /* ALLOWED: @allowed_ops */ \\\n"; printf $fh " /* ALLOWED: @allowed_ops */ \\\n";
foreach my $opname (opset_to_ops(opset(@allowed_ops))) { foreach my $opname (opset_to_ops(opset(@allowed_ops)))
{
printf $fh qq{ opmask[OP_%-12s] = 0;\t/* %s */ \\\n}, printf $fh qq{ opmask[OP_%-12s] = 0;\t/* %s */ \\\n},
uc($opname), opdesc($opname); uc($opname), opdesc($opname);
} }
printf $fh " /* end */ \n"; printf $fh " /* end */ \n";
close $fh close $fh
or die "Error closing $plperl_opmask_tmp: $!"; or die "Error closing $plperl_opmask_tmp: $!";
rename $plperl_opmask_tmp, $plperl_opmask_h rename $plperl_opmask_tmp, $plperl_opmask_h
or die "Error renaming $plperl_opmask_tmp to $plperl_opmask_h: $!"; or die "Error renaming $plperl_opmask_tmp to $plperl_opmask_h: $!";
exit 0; exit 0;
src/pl/plperl/text2macro.pl
View file @ 042d9ffc
...@@ -32,11 +32,10 @@ GetOptions( ...@@ -32,11 +32,10 @@ GetOptions(
'prefix=s' => \my $opt_prefix, 'prefix=s' => \my $opt_prefix,
'name=s' => \my $opt_name, 'name=s' => \my $opt_name,
'strip=s' => \my $opt_strip, 'strip=s' => \my $opt_strip,
'selftest!' => sub { exit selftest() }, 'selftest!' => sub { exit selftest() },) or exit 1;
) or exit 1;
die "No text files specified" die "No text files specified"
unless @ARGV; unless @ARGV;
print qq{ print qq{
/* /*
...@@ -45,17 +44,19 @@ print qq{ ...@@ -45,17 +44,19 @@ print qq{
*/ */
}; };
for my $src_file (@ARGV) { for my $src_file (@ARGV)
{
(my $macro = $src_file) =~ s/ .*? (\w+) (?:\.\w+) $/$1/x; (my $macro = $src_file) =~ s/ .*? (\w+) (?:\.\w+) $/$1/x;
open my $src_fh, $src_file # not 3-arg form open my $src_fh, $src_file # not 3-arg form
or die "Can't open $src_file: $!"; or die "Can't open $src_file: $!";
printf qq{#define %s%s \\\n}, printf qq{#define %s%s \\\n},
$opt_prefix || '', $opt_prefix || '',
($opt_name) ? $opt_name : uc $macro; ($opt_name) ? $opt_name : uc $macro;
while (<$src_fh>) { while (<$src_fh>)
{
chomp; chomp;
next if $opt_strip and m/$opt_strip/o; next if $opt_strip and m/$opt_strip/o;
...@@ -74,8 +75,9 @@ print "/* end */\n"; ...@@ -74,8 +75,9 @@ print "/* end */\n";
exit 0; exit 0;
sub selftest { sub selftest
my $tmp = "text2macro_tmp"; {
my $tmp = "text2macro_tmp";
my $string = q{a '' '\\'' "" "\\"" "\\\\" "\\\\n" b}; my $string = q{a '' '\\'' "" "\\"" "\\\\" "\\\\n" b};
open my $fh, ">$tmp.pl" or die; open my $fh, ">$tmp.pl" or die;
......
src/pl/plpgsql/src/generate-plerrcodes.pl
View file @ 042d9ffc
...@@ -6,35 +6,35 @@ ...@@ -6,35 +6,35 @@
use warnings; use warnings;
use strict; use strict;
print "/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n"; print
"/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n";
print "/* there is deliberately not an #ifndef PLERRCODES_H here */\n"; print "/* there is deliberately not an #ifndef PLERRCODES_H here */\n";
open my $errcodes, $ARGV[0] or die; open my $errcodes, $ARGV[0] or die;
while (<$errcodes>) { while (<$errcodes>)
chomp; {
chomp;
# Skip comments # Skip comments
next if /^#/; next if /^#/;
next if /^\s*$/; next if /^\s*$/;
# Skip section headers # Skip section headers
next if /^Section:/; next if /^Section:/;
die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/; die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/;
(my $sqlstate, (my $sqlstate, my $type, my $errcode_macro, my $condition_name) =
my $type, ($1, $2, $3, $4);
my $errcode_macro,
my $condition_name) = ($1, $2, $3, $4);
# Skip non-errors # Skip non-errors
next unless $type eq 'E'; next unless $type eq 'E';
# Skip lines without PL/pgSQL condition names # Skip lines without PL/pgSQL condition names
next unless defined($condition_name); next unless defined($condition_name);
print "{\n\t\"$condition_name\", $errcode_macro\n},\n\n"; print "{\n\t\"$condition_name\", $errcode_macro\n},\n\n";
} }
close $errcodes; close $errcodes;
src/pl/plpython/generate-spiexceptions.pl
View file @ 042d9ffc
...@@ -6,39 +6,39 @@ ...@@ -6,39 +6,39 @@
use warnings; use warnings;
use strict; use strict;
print "/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n"; print
"/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n";
print "/* there is deliberately not an #ifndef SPIEXCEPTIONS_H here */\n"; print "/* there is deliberately not an #ifndef SPIEXCEPTIONS_H here */\n";
open my $errcodes, $ARGV[0] or die; open my $errcodes, $ARGV[0] or die;
while (<$errcodes>) { while (<$errcodes>)
chomp; {
chomp;
# Skip comments # Skip comments
next if /^#/; next if /^#/;
next if /^\s*$/; next if /^\s*$/;
# Skip section headers # Skip section headers
next if /^Section:/; next if /^Section:/;
die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/; die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/;
(my $sqlstate, (my $sqlstate, my $type, my $errcode_macro, my $condition_name) =
my $type, ($1, $2, $3, $4);
my $errcode_macro,
my $condition_name) = ($1, $2, $3, $4);
# Skip non-errors # Skip non-errors
next unless $type eq 'E'; next unless $type eq 'E';
# Skip lines without PL/pgSQL condition names # Skip lines without PL/pgSQL condition names
next unless defined($condition_name); next unless defined($condition_name);
# Change some_error_condition to SomeErrorCondition # Change some_error_condition to SomeErrorCondition
$condition_name =~ s/([a-z])([^_]*)(?:_|$)/\u$1$2/g; $condition_name =~ s/([a-z])([^_]*)(?:_|$)/\u$1$2/g;
print "{ \"spiexceptions.$condition_name\", " . print "{ \"spiexceptions.$condition_name\", "
"\"$condition_name\", $errcode_macro },\n"; . "\"$condition_name\", $errcode_macro },\n";
} }
close $errcodes; close $errcodes;
src/test/locale/sort-test.pl
View file @ 042d9ffc
...@@ -2,10 +2,10 @@ ...@@ -2,10 +2,10 @@
use locale; use locale;
open(INFILE, "<$ARGV[0]"); open(INFILE, "<$ARGV[0]");
chop(my(@words) = <INFILE>); chop(my (@words) = <INFILE>);
close(INFILE); close(INFILE);
$"="\n"; $" = "\n";
my(@result) = sort @words; my (@result) = sort @words;
print "@result\n"; print "@result\n";
src/test/performance/runtests.pl
View file @ 042d9ffc
...@@ -10,9 +10,9 @@ $DBNAME = 'perftest'; ...@@ -10,9 +10,9 @@ $DBNAME = 'perftest';
# This describtion for all DBMS supported by test # This describtion for all DBMS supported by test
# DBMS_name => [FrontEnd, DestroyDB command, CreateDB command] # DBMS_name => [FrontEnd, DestroyDB command, CreateDB command]
%DBMS = ( %DBMS =
'pgsql' => ["psql -q -d $DBNAME", "destroydb $DBNAME", "createdb $DBNAME"] ('pgsql' =>
); [ "psql -q -d $DBNAME", "destroydb $DBNAME", "createdb $DBNAME" ]);
# Tests to run: test' script, test' description, ... # Tests to run: test' script, test' description, ...
# Test' script is in form # Test' script is in form
...@@ -34,30 +34,37 @@ $DBNAME = 'perftest'; ...@@ -34,30 +34,37 @@ $DBNAME = 'perftest';
# an idea of what can be done for features unsupported by an DBMS.) # an idea of what can be done for features unsupported by an DBMS.)
# #
@perftests = ( @perftests = (
# It speed up things
'connection.ntm', 'DB connection startup (no timing)', # It speed up things
# Just connection startup time (echo "" | psql ... - for PgSQL) 'connection.ntm', 'DB connection startup (no timing)',
'connection', 'DB connection startup',
'crtsimple.ntm', 'Create SIMPLE table (no timing)', # Just connection startup time (echo "" | psql ... - for PgSQL)
# 8192 inserts in single xaction 'connection', 'DB connection startup',
'inssimple T', '8192 INSERTs INTO SIMPLE (1 xact)', 'crtsimple.ntm', 'Create SIMPLE table (no timing)',
'drpsimple.ntm', 'Drop SIMPLE table (no timing)',
'crtsimple.ntm', 'Create SIMPLE table (no timing)', # 8192 inserts in single xaction
# 8192 inserts in 8192 xactions 'inssimple T', '8192 INSERTs INTO SIMPLE (1 xact)',
'inssimple', '8192 INSERTs INTO SIMPLE (8192 xacts)', 'drpsimple.ntm', 'Drop SIMPLE table (no timing)',
'vacuum.ntm', 'Vacuum (no timing)', 'crtsimple.ntm', 'Create SIMPLE table (no timing)',
# Fast (after table filled with data) index creation test
'crtsimpleidx', 'Create INDEX on SIMPLE', # 8192 inserts in 8192 xactions
'drpsimple.ntm', 'Drop SIMPLE table (no timing)', 'inssimple', '8192 INSERTs INTO SIMPLE (8192 xacts)',
'crtsimple.ntm', 'Create SIMPLE table (no timing)', 'vacuum.ntm', 'Vacuum (no timing)',
'crtsimpleidx.ntm', 'Create INDEX on SIMPLE (no timing)',
# 8192 inserts in single xaction into table with index # Fast (after table filled with data) index creation test
'inssimple T', '8192 INSERTs INTO SIMPLE with INDEX (1 xact)', 'crtsimpleidx', 'Create INDEX on SIMPLE',
# 8192 SELECT * FROM simple WHERE justint = <random_key> in single xaction 'drpsimple.ntm', 'Drop SIMPLE table (no timing)',
'slcsimple T', '8192 random INDEX scans on SIMPLE (1 xact)', 'crtsimple.ntm', 'Create SIMPLE table (no timing)',
# SELECT * FROM simple ORDER BY justint 'crtsimpleidx.ntm', 'Create INDEX on SIMPLE (no timing)',
'orbsimple', 'ORDER BY SIMPLE',
); # 8192 inserts in single xaction into table with index
'inssimple T', '8192 INSERTs INTO SIMPLE with INDEX (1 xact)',
# 8192 SELECT * FROM simple WHERE justint = <random_key> in single xaction
'slcsimple T', '8192 random INDEX scans on SIMPLE (1 xact)',
# SELECT * FROM simple ORDER BY justint
'orbsimple', 'ORDER BY SIMPLE',);
# #
# It seems that nothing below need to be changed # It seems that nothing below need to be changed
...@@ -66,72 +73,76 @@ $DBNAME = 'perftest'; ...@@ -66,72 +73,76 @@ $DBNAME = 'perftest';
$TestDBMS = $ARGV[0]; $TestDBMS = $ARGV[0];
die "Unsupported DBMS $TestDBMS\n" if !exists $DBMS{$TestDBMS}; die "Unsupported DBMS $TestDBMS\n" if !exists $DBMS{$TestDBMS};
$FrontEnd = $DBMS{$TestDBMS}[0]; $FrontEnd = $DBMS{$TestDBMS}[0];
$DestroyDB = $DBMS{$TestDBMS}[1]; $DestroyDB = $DBMS{$TestDBMS}[1];
$CreateDB = $DBMS{$TestDBMS}[2]; $CreateDB = $DBMS{$TestDBMS}[2];
print "(Re)create DataBase $DBNAME\n"; print "(Re)create DataBase $DBNAME\n";
`$DestroyDB`; # Destroy DB `$DestroyDB`; # Destroy DB
`$CreateDB`; # Create DB `$CreateDB`; # Create DB
$ResFile = "Results.$TestDBMS"; $ResFile = "Results.$TestDBMS";
$TmpFile = "Tmp.$TestDBMS"; $TmpFile = "Tmp.$TestDBMS";
open (SAVEOUT, ">&STDOUT"); open(SAVEOUT, ">&STDOUT");
open (STDOUT, ">/dev/null") or die; open(STDOUT, ">/dev/null") or die;
open (SAVEERR, ">&STDERR"); open(SAVEERR, ">&STDERR");
open (STDERR, ">$TmpFile") or die; open(STDERR, ">$TmpFile") or die;
select (STDERR); $| = 1; select(STDERR);
$| = 1;
for ($i = 0; $i <= $#perftests; $i++) for ($i = 0; $i <= $#perftests; $i++)
{ {
$test = $perftests[$i]; $test = $perftests[$i];
($test, $XACTBLOCK) = split (/ /, $test); ($test, $XACTBLOCK) = split(/ /, $test);
$runtest = $test; $runtest = $test;
if ( $test =~ /\.ntm/ ) if ($test =~ /\.ntm/)
{ {
# #
# No timing for this queries # No timing for this queries
# #
close (STDERR); # close $TmpFile close(STDERR); # close $TmpFile
open (STDERR, ">/dev/null") or die; open(STDERR, ">/dev/null") or die;
$runtest =~ s/\.ntm//; $runtest =~ s/\.ntm//;
} }
else else
{ {
close (STDOUT); close(STDOUT);
open(STDOUT, ">&SAVEOUT"); open(STDOUT, ">&SAVEOUT");
print STDOUT "\nRunning: $perftests[$i+1] ..."; print STDOUT "\nRunning: $perftests[$i+1] ...";
close (STDOUT); close(STDOUT);
open (STDOUT, ">/dev/null") or die; open(STDOUT, ">/dev/null") or die;
select (STDERR); $| = 1; select(STDERR);
$| = 1;
printf "$perftests[$i+1]: "; printf "$perftests[$i+1]: ";
} }
do "sqls/$runtest"; do "sqls/$runtest";
# Restore STDERR to $TmpFile # Restore STDERR to $TmpFile
if ( $test =~ /\.ntm/ ) if ($test =~ /\.ntm/)
{ {
close (STDERR); close(STDERR);
open (STDERR, ">>$TmpFile") or die; open(STDERR, ">>$TmpFile") or die;
} }
select (STDERR); $| = 1; select(STDERR);
$| = 1;
$i++; $i++;
} }
close (STDERR); close(STDERR);
open(STDERR, ">&SAVEERR"); open(STDERR, ">&SAVEERR");
open (TMPF, "<$TmpFile") or die; open(TMPF, "<$TmpFile") or die;
open (RESF, ">$ResFile") or die; open(RESF, ">$ResFile") or die;
while (<TMPF>) while (<TMPF>)
{ {
$str = $_; $str = $_;
($test, $rtime) = split (/:/, $str); ($test, $rtime) = split(/:/, $str);
($tmp, $rtime, $rest) = split (/[ ]+/, $rtime); ($tmp, $rtime, $rest) = split(/[ ]+/, $rtime);
print RESF "$test: $rtime\n"; print RESF "$test: $rtime\n";
} }
src/tools/check_bison_recursion.pl
View file @ 042d9ffc
...@@ -32,43 +32,59 @@ my $cur_nonterminal; ...@@ -32,43 +32,59 @@ my $cur_nonterminal;
# We parse the input and emit warnings on the fly. # We parse the input and emit warnings on the fly.
my $in_grammar = 0; my $in_grammar = 0;
while (<>) { while (<>)
my $rule_number; {
my $rhs; my $rule_number;
my $rhs;
# We only care about the "Grammar" part of the input. # We only care about the "Grammar" part of the input.
if (m/^Grammar$/) { if (m/^Grammar$/)
$in_grammar = 1; {
} elsif (m/^Terminal/) { $in_grammar = 1;
$in_grammar = 0;
} elsif ($in_grammar) {
if (m/^\s*(\d+)\s+(\S+):\s+(.*)$/) {
# first rule for nonterminal
$rule_number = $1;
$cur_nonterminal = $2;
$rhs = $3;
} elsif (m/^\s*(\d+)\s+\|\s+(.*)$/) {
# additional rule for nonterminal
$rule_number = $1;
$rhs = $2;
} }
} elsif (m/^Terminal/)
{
$in_grammar = 0;
}
elsif ($in_grammar)
{
if (m/^\s*(\d+)\s+(\S+):\s+(.*)$/)
{
# first rule for nonterminal
$rule_number = $1;
$cur_nonterminal = $2;
$rhs = $3;
}
elsif (m/^\s*(\d+)\s+\|\s+(.*)$/)
{
# additional rule for nonterminal
$rule_number = $1;
$rhs = $2;
}
}
# Process rule if we found one
if (defined $rule_number)
{
# deconstruct the RHS
$rhs =~ s|^/\* empty \*/$||;
my @rhs = split '\s', $rhs;
print "Rule $rule_number: $cur_nonterminal := @rhs\n" if $debug;
# Process rule if we found one # We complain if the nonterminal appears as the last RHS element
if (defined $rule_number) { # but not elsewhere, since "expr := expr + expr" is reasonable
# deconstruct the RHS my $lastrhs = pop @rhs;
$rhs =~ s|^/\* empty \*/$||; if ( defined $lastrhs
my @rhs = split '\s', $rhs; && $cur_nonterminal eq $lastrhs
print "Rule $rule_number: $cur_nonterminal := @rhs\n" if $debug; && !grep { $cur_nonterminal eq $_ } @rhs)
# We complain if the nonterminal appears as the last RHS element {
# but not elsewhere, since "expr := expr + expr" is reasonable print
my $lastrhs = pop @rhs; "Right recursion in rule $rule_number: $cur_nonterminal := $rhs\n";
if (defined $lastrhs && }
$cur_nonterminal eq $lastrhs &&
!grep { $cur_nonterminal eq $_ } @rhs) {
print "Right recursion in rule $rule_number: $cur_nonterminal := $rhs\n";
} }
}
} }
exit 0; exit 0;
src/tools/check_keywords.pl
View file @ 042d9ffc
...@@ -10,26 +10,30 @@ use strict; ...@@ -10,26 +10,30 @@ use strict;
my $errors = 0; my $errors = 0;
my $path; my $path;
sub error(@) { sub error(@)
print STDERR @_; {
$errors = 1; print STDERR @_;
$errors = 1;
} }
if (@ARGV) { if (@ARGV)
{
$path = $ARGV[0]; $path = $ARGV[0];
shift @ARGV; shift @ARGV;
} else { }
else
{
$path = "."; $path = ".";
} }
$, = ' '; # set output field separator $, = ' '; # set output field separator
$\ = "\n"; # set output record separator $\ = "\n"; # set output record separator
my %keyword_categories; my %keyword_categories;
$keyword_categories{'unreserved_keyword'} = 'UNRESERVED_KEYWORD'; $keyword_categories{'unreserved_keyword'} = 'UNRESERVED_KEYWORD';
$keyword_categories{'col_name_keyword'} = 'COL_NAME_KEYWORD'; $keyword_categories{'col_name_keyword'} = 'COL_NAME_KEYWORD';
$keyword_categories{'type_func_name_keyword'} = 'TYPE_FUNC_NAME_KEYWORD'; $keyword_categories{'type_func_name_keyword'} = 'TYPE_FUNC_NAME_KEYWORD';
$keyword_categories{'reserved_keyword'} = 'RESERVED_KEYWORD'; $keyword_categories{'reserved_keyword'} = 'RESERVED_KEYWORD';
my $gram_filename = "$path/src/backend/parser/gram.y"; my $gram_filename = "$path/src/backend/parser/gram.y";
open(GRAM, $gram_filename) || die("Could not open : $gram_filename"); open(GRAM, $gram_filename) || die("Could not open : $gram_filename");
...@@ -39,80 +43,101 @@ my $comment; ...@@ -39,80 +43,101 @@ my $comment;
my @arr; my @arr;
my %keywords; my %keywords;
line: while (<GRAM>) { line: while (<GRAM>)
chomp; # strip record separator {
chomp; # strip record separator
$S = $_;
# Make sure any braces are split
$s = '{', $S =~ s/$s/ { /g;
$s = '}', $S =~ s/$s/ } /g;
# Any comments are split
$s = '[/][*]', $S =~ s#$s# /* #g;
$s = '[*][/]', $S =~ s#$s# */ #g;
if (!($kcat)) {
# Is this the beginning of a keyword list?
foreach $k (keys %keyword_categories) {
if ($S =~ m/^($k):/) {
$kcat = $k;
next line;
}
}
next line;
}
# Now split the line into individual fields $S = $_;
$n = (@arr = split(' ', $S));
# Ok, we're in a keyword list. Go through each field in turn # Make sure any braces are split
for (my $fieldIndexer = 0; $fieldIndexer < $n; $fieldIndexer++) { $s = '{', $S =~ s/$s/ { /g;
if ($arr[$fieldIndexer] eq '*/' && $comment) { $s = '}', $S =~ s/$s/ } /g;
$comment = 0;
next;
}
elsif ($comment) {
next;
}
elsif ($arr[$fieldIndexer] eq '/*') {
# start of a multiline comment
$comment = 1;
next;
}
elsif ($arr[$fieldIndexer] eq '//') {
next line;
}
if ($arr[$fieldIndexer] eq ';') { # Any comments are split
# end of keyword list $s = '[/][*]', $S =~ s#$s# /* #g;
$kcat = ''; $s = '[*][/]', $S =~ s#$s# */ #g;
next;
}
if ($arr[$fieldIndexer] eq '|') { if (!($kcat))
next; {
# Is this the beginning of a keyword list?
foreach $k (keys %keyword_categories)
{
if ($S =~ m/^($k):/)
{
$kcat = $k;
next line;
}
}
next line;
} }
# Put this keyword into the right list # Now split the line into individual fields
push @{$keywords{$kcat}}, $arr[$fieldIndexer]; $n = (@arr = split(' ', $S));
}
# Ok, we're in a keyword list. Go through each field in turn
for (my $fieldIndexer = 0; $fieldIndexer < $n; $fieldIndexer++)
{
if ($arr[$fieldIndexer] eq '*/' && $comment)
{
$comment = 0;
next;
}
elsif ($comment)
{
next;
}
elsif ($arr[$fieldIndexer] eq '/*')
{
# start of a multiline comment
$comment = 1;
next;
}
elsif ($arr[$fieldIndexer] eq '//')
{
next line;
}
if ($arr[$fieldIndexer] eq ';')
{
# end of keyword list
$kcat = '';
next;
}
if ($arr[$fieldIndexer] eq '|')
{
next;
}
# Put this keyword into the right list
push @{ $keywords{$kcat} }, $arr[$fieldIndexer];
}
} }
close GRAM; close GRAM;
# Check that all keywords are in alphabetical order # Check that all keywords are in alphabetical order
my ($prevkword, $kword, $bare_kword); my ($prevkword, $kword, $bare_kword);
foreach $kcat (keys %keyword_categories) { foreach $kcat (keys %keyword_categories)
$prevkword = ''; {
$prevkword = '';
foreach $kword (@{$keywords{$kcat}}) {
# Some keyword have a _P suffix. Remove it for the comparison. foreach $kword (@{ $keywords{$kcat} })
$bare_kword = $kword; {
$bare_kword =~ s/_P$//;
if ($bare_kword le $prevkword) { # Some keyword have a _P suffix. Remove it for the comparison.
error "'$bare_kword' after '$prevkword' in $kcat list is misplaced"; $bare_kword = $kword;
$errors = 1; $bare_kword =~ s/_P$//;
if ($bare_kword le $prevkword)
{
error
"'$bare_kword' after '$prevkword' in $kcat list is misplaced";
$errors = 1;
}
$prevkword = $bare_kword;
} }
$prevkword = $bare_kword;
}
} }
# Transform the keyword lists into hashes. # Transform the keyword lists into hashes.
...@@ -120,13 +145,14 @@ foreach $kcat (keys %keyword_categories) { ...@@ -120,13 +145,14 @@ foreach $kcat (keys %keyword_categories) {
# UNRESERVED_KEYWORD. Each inner hash is a keyed by keyword id, e.g. ABORT_P # UNRESERVED_KEYWORD. Each inner hash is a keyed by keyword id, e.g. ABORT_P
# with a dummy value. # with a dummy value.
my %kwhashes; my %kwhashes;
while ( my ($kcat, $kcat_id) = each(%keyword_categories) ) { while (my ($kcat, $kcat_id) = each(%keyword_categories))
@arr = @{$keywords{$kcat}}; {
@arr = @{ $keywords{$kcat} };
my $hash; my $hash;
foreach my $item (@arr) { $hash->{$item} = 1 } foreach my $item (@arr) { $hash->{$item} = 1 }
$kwhashes{$kcat_id} = $hash; $kwhashes{$kcat_id} = $hash;
} }
# Now read in kwlist.h # Now read in kwlist.h
...@@ -137,63 +163,82 @@ open(KWLIST, $kwlist_filename) || die("Could not open : $kwlist_filename"); ...@@ -137,63 +163,82 @@ open(KWLIST, $kwlist_filename) || die("Could not open : $kwlist_filename");
my $prevkwstring = ''; my $prevkwstring = '';
my $bare_kwname; my $bare_kwname;
my %kwhash; my %kwhash;
kwlist_line: while (<KWLIST>) { kwlist_line: while (<KWLIST>)
my($line) = $_; {
my ($line) = $_;
if ($line =~ /^PG_KEYWORD\(\"(.*)\", (.*), (.*)\)/)
{ if ($line =~ /^PG_KEYWORD\(\"(.*)\", (.*), (.*)\)/)
my($kwstring) = $1; {
my($kwname) = $2; my ($kwstring) = $1;
my($kwcat_id) = $3; my ($kwname) = $2;
my ($kwcat_id) = $3;
# Check that the list is in alphabetical order
if ($kwstring le $prevkwstring) { # Check that the list is in alphabetical order
error "'$kwstring' after '$prevkwstring' in kwlist.h is misplaced"; if ($kwstring le $prevkwstring)
} {
$prevkwstring = $kwstring; error
"'$kwstring' after '$prevkwstring' in kwlist.h is misplaced";
# Check that the keyword string is valid: all lower-case ASCII chars }
if ($kwstring !~ /^[a-z_]*$/) { $prevkwstring = $kwstring;
error "'$kwstring' is not a valid keyword string, must be all lower-case ASCII chars";
} # Check that the keyword string is valid: all lower-case ASCII chars
if ($kwstring !~ /^[a-z_]*$/)
# Check that the keyword name is valid: all upper-case ASCII chars {
if ($kwname !~ /^[A-Z_]*$/) { error
error "'$kwname' is not a valid keyword name, must be all upper-case ASCII chars"; "'$kwstring' is not a valid keyword string, must be all lower-case ASCII chars";
}
# Check that the keyword name is valid: all upper-case ASCII chars
if ($kwname !~ /^[A-Z_]*$/)
{
error
"'$kwname' is not a valid keyword name, must be all upper-case ASCII chars";
}
# Check that the keyword string matches keyword name
$bare_kwname = $kwname;
$bare_kwname =~ s/_P$//;
if ($bare_kwname ne uc($kwstring))
{
error
"keyword name '$kwname' doesn't match keyword string '$kwstring'";
}
# Check that the keyword is present in the grammar
%kwhash = %{ $kwhashes{$kwcat_id} };
if (!(%kwhash))
{
#error "Unknown kwcat_id: $kwcat_id";
}
else
{
if (!($kwhash{$kwname}))
{
error "'$kwname' not present in $kwcat_id section of gram.y";
}
else
{
# Remove it from the hash, so that we can complain at the end
# if there's keywords left that were not found in kwlist.h
delete $kwhashes{$kwcat_id}->{$kwname};
}
}
} }
# Check that the keyword string matches keyword name
$bare_kwname = $kwname;
$bare_kwname =~ s/_P$//;
if ($bare_kwname ne uc($kwstring)) {
error "keyword name '$kwname' doesn't match keyword string '$kwstring'";
}
# Check that the keyword is present in the grammar
%kwhash = %{$kwhashes{$kwcat_id}};
if (!(%kwhash)) {
#error "Unknown kwcat_id: $kwcat_id";
} else {
if (!($kwhash{$kwname})) {
error "'$kwname' not present in $kwcat_id section of gram.y";
} else {
# Remove it from the hash, so that we can complain at the end
# if there's keywords left that were not found in kwlist.h
delete $kwhashes{$kwcat_id}->{$kwname};
}
}
}
} }
close KWLIST; close KWLIST;
# Check that we've paired up all keywords from gram.y with lines in kwlist.h # Check that we've paired up all keywords from gram.y with lines in kwlist.h
while ( my ($kwcat, $kwcat_id) = each(%keyword_categories) ) { while (my ($kwcat, $kwcat_id) = each(%keyword_categories))
%kwhash = %{$kwhashes{$kwcat_id}}; {
%kwhash = %{ $kwhashes{$kwcat_id} };
for my $kw ( keys %kwhash ) { for my $kw (keys %kwhash)
error "'$kw' found in gram.y $kwcat category, but not in kwlist.h" {
} error "'$kw' found in gram.y $kwcat category, but not in kwlist.h";
}
} }
exit $errors; exit $errors;
src/tools/copyright.pl
View file @ 042d9ffc
...@@ -14,43 +14,52 @@ use File::Find; ...@@ -14,43 +14,52 @@ use File::Find;
use Tie::File; use Tie::File;
my $pgdg = 'PostgreSQL Global Development Group'; my $pgdg = 'PostgreSQL Global Development Group';
my $cc = 'Copyright \(c\) '; my $cc = 'Copyright \(c\) ';
# year-1900 is what localtime(time) puts in element 5 # year-1900 is what localtime(time) puts in element 5
my $year = 1900 + ${[localtime(time)]}[5]; my $year = 1900 + ${ [ localtime(time) ] }[5];
print "Using current year: $year\n"; print "Using current year: $year\n";
find({wanted => \&wanted, no_chdir => 1}, '.'); find({ wanted => \&wanted, no_chdir => 1 }, '.');
sub wanted
{
sub wanted { # prevent corruption of git indexes by ignoring any .git/
# prevent corruption of git indexes by ignoring any .git/ if ($_ eq '.git')
if ($_ eq '.git') {
{ $File::Find::prune = 1;
$File::Find::prune = 1; return;
return; }
}
return if ! -f $File::Find::name || -l $File::Find::name; return if !-f $File::Find::name || -l $File::Find::name;
# skip file names with binary extensions
# How are these updated? bjm 2012-01-02 # skip file names with binary extensions
return if ($_ =~ m/\.(ico|bin)$); # How are these updated? bjm 2012-01-02
return
if (
$_ =~ m/\.(ico|bin)$);
my @lines; my @lines;
tie @lines, "Tie::File", $File::Find::name; tie @lines, "Tie::File", $File::Find::name;
foreach my $line (@lines) { foreach my $line (@lines) {
# We only care about lines with a copyright notice. # We only care about lines with a copyright notice.
next unless $line =~ m/$cc.*$pgdg/; next unless $line =~ m/$cc . *$pgdg /;
# We stop when we've done one substitution. This is both for
# efficiency and, at least in the case of this program, for # We stop when we've done one substitution. This is both for
# correctness. # efficiency and, at least in the case of this program, for
last if $line =~ m/$cc.*$year.*$pgdg/; # correctness.
last if $line =~ s/($cc\d{4})(, $pgdg)/$1-$year$2/; last if $line =~ m/$cc.*$year.*$pgdg/;
last if $line =~ s/($cc\d{4})-\d{4}(, $pgdg)/$1-$year$2/; last if $line =~ s/($cc\d{4})(, $pgdg)/$1-$year$2/;
} last if $line =~ s/($cc\d{4})-\d{4}(, $pgdg)/$1-$year$2/;
untie @lines; }
untie @lines;
} }
print "Manually update doc/src/sgml/legal.sgml and src/interfaces/libpq/libpq.rc.in too.\n"; print
print "Also update ./COPYRIGHT and doc/src/sgml/legal.sgml in all back branches.\n"; "Manually update doc/src/sgml/legal.sgml and src/interfaces/libpq/libpq.rc.in too.\n";
print
"Also update ./COPYRIGHT and doc/src/sgml/legal.sgml in all back branches.\n";
src/tools/msvc/Install.pm
View file @ 042d9ffc
...@@ -13,13 +13,13 @@ use File::Copy; ...@@ -13,13 +13,13 @@ use File::Copy;
use File::Find (); use File::Find ();
use Exporter; use Exporter;
our (@ISA,@EXPORT_OK); our (@ISA, @EXPORT_OK);
@ISA = qw(Exporter); @ISA = qw(Exporter);
@EXPORT_OK = qw(Install); @EXPORT_OK = qw(Install);
sub lcopy sub lcopy
{ {
my $src = shift; my $src = shift;
my $target = shift; my $target = shift;
if (-f $target) if (-f $target)
...@@ -27,7 +27,7 @@ sub lcopy ...@@ -27,7 +27,7 @@ sub lcopy
unlink $target || confess "Could not delete $target\n"; unlink $target || confess "Could not delete $target\n";
} }
copy($src,$target) copy($src, $target)
|| confess "Could not copy $src to $target\n"; || confess "Could not copy $src to $target\n";
} }
...@@ -41,7 +41,7 @@ sub Install ...@@ -41,7 +41,7 @@ sub Install
require "config_default.pl"; require "config_default.pl";
require "config.pl" if (-f "config.pl"); require "config.pl" if (-f "config.pl");
chdir("../../..") if (-f "../../../configure"); chdir("../../..") if (-f "../../../configure");
chdir("../../../..") if (-f "../../../../configure"); chdir("../../../..") if (-f "../../../../configure");
my $conf = ""; my $conf = "";
if (-d "debug") if (-d "debug")
...@@ -56,83 +56,79 @@ sub Install ...@@ -56,83 +56,79 @@ sub Install
my $majorver = DetermineMajorVersion(); my $majorver = DetermineMajorVersion();
print "Installing version $majorver for $conf in $target\n"; print "Installing version $majorver for $conf in $target\n";
EnsureDirectories($target, 'bin', 'lib', 'share','share/timezonesets','share/extension', EnsureDirectories(
'share/contrib','doc','doc/extension', 'doc/contrib','symbols', $target, 'bin',
'share/tsearch_data'); 'lib', 'share',
'share/timezonesets', 'share/extension',
'share/contrib', 'doc',
'doc/extension', 'doc/contrib',
'symbols', 'share/tsearch_data');
CopySolutionOutput($conf, $target); CopySolutionOutput($conf, $target);
lcopy($target . '/lib/libpq.dll', $target . '/bin/libpq.dll'); lcopy($target . '/lib/libpq.dll', $target . '/bin/libpq.dll');
my $sample_files = []; my $sample_files = [];
File::Find::find( File::Find::find(
{ { wanted => sub {
wanted =>sub {
/^.*\.sample\z/s /^.*\.sample\z/s
&&push(@$sample_files, $File::Find::name); && push(@$sample_files, $File::Find::name);
} }
}, },
"src" "src");
);
CopySetOfFiles('config files', $sample_files, $target . '/share/'); CopySetOfFiles('config files', $sample_files, $target . '/share/');
CopyFiles( CopyFiles(
'Import libraries', 'Import libraries', $target . '/lib/',
$target .'/lib/', "$conf\\", "postgres\\postgres.lib",
"$conf\\", "postgres\\postgres.lib","libpq\\libpq.lib", "libecpg\\libecpg.lib", "libpq\\libpq.lib", "libecpg\\libecpg.lib",
"libpgport\\libpgport.lib" "libpgport\\libpgport.lib");
);
CopySetOfFiles( CopySetOfFiles(
'timezone names', 'timezone names',
[ glob('src\timezone\tznames\*.txt') ], [ glob('src\timezone\tznames\*.txt') ],
$target . '/share/timezonesets/' $target . '/share/timezonesets/');
);
CopyFiles( CopyFiles(
'timezone sets', 'timezone sets',
$target . '/share/timezonesets/', $target . '/share/timezonesets/',
'src/timezone/tznames/', 'Default','Australia','India' 'src/timezone/tznames/', 'Default', 'Australia', 'India');
);
CopySetOfFiles( CopySetOfFiles(
'BKI files', 'BKI files',
[ glob("src\\backend\\catalog\\postgres.*") ], [ glob("src\\backend\\catalog\\postgres.*") ],
$target .'/share/' $target . '/share/');
); CopySetOfFiles(
CopySetOfFiles('SQL files', [ glob("src\\backend\\catalog\\*.sql") ],$target . '/share/'); 'SQL files',
[ glob("src\\backend\\catalog\\*.sql") ],
$target . '/share/');
CopyFiles( CopyFiles(
'Information schema data',$target . '/share/', 'Information schema data', $target . '/share/',
'src/backend/catalog/', 'sql_features.txt' 'src/backend/catalog/', 'sql_features.txt');
);
GenerateConversionScript($target); GenerateConversionScript($target);
GenerateTimezoneFiles($target,$conf); GenerateTimezoneFiles($target, $conf);
GenerateTsearchFiles($target); GenerateTsearchFiles($target);
CopySetOfFiles( CopySetOfFiles(
'Stopword files', 'Stopword files',
[ glob("src\\backend\\snowball\\stopwords\\*.stop") ], [ glob("src\\backend\\snowball\\stopwords\\*.stop") ],
$target . '/share/tsearch_data/' $target . '/share/tsearch_data/');
);
CopySetOfFiles( CopySetOfFiles(
'Dictionaries sample files', 'Dictionaries sample files',
[ glob("src\\backend\\tsearch\\*_sample.*") ], [ glob("src\\backend\\tsearch\\*_sample.*") ],
$target . '/share/tsearch_data/' $target . '/share/tsearch_data/');
); CopyContribFiles($config, $target);
CopyContribFiles($config,$target);
CopyIncludeFiles($target); CopyIncludeFiles($target);
my $pl_extension_files = []; my $pl_extension_files = [];
my @pldirs = ('src/pl/plpgsql/src'); my @pldirs = ('src/pl/plpgsql/src');
push @pldirs,"src/pl/plperl" if $config->{perl}; push @pldirs, "src/pl/plperl" if $config->{perl};
push @pldirs,"src/pl/plpython" if $config->{python}; push @pldirs, "src/pl/plpython" if $config->{python};
push @pldirs,"src/pl/tcl" if $config->{tcl}; push @pldirs, "src/pl/tcl" if $config->{tcl};
File::Find::find( File::Find::find(
{ { wanted => sub {
wanted =>sub {
/^(.*--.*\.sql|.*\.control)\z/s /^(.*--.*\.sql|.*\.control)\z/s
&&push(@$pl_extension_files, && push(@$pl_extension_files, $File::Find::name);
$File::Find::name);
} }
}, },
@pldirs @pldirs);
); CopySetOfFiles('PL Extension files',
CopySetOfFiles('PL Extension files', $pl_extension_files,$target . '/share/extension/'); $pl_extension_files, $target . '/share/extension/');
GenerateNLSFiles($target,$config->{nls},$majorver) if ($config->{nls}); GenerateNLSFiles($target, $config->{nls}, $majorver) if ($config->{nls});
print "Installation complete.\n"; print "Installation complete.\n";
} }
...@@ -149,8 +145,8 @@ sub EnsureDirectories ...@@ -149,8 +145,8 @@ sub EnsureDirectories
sub CopyFiles sub CopyFiles
{ {
my $what = shift; my $what = shift;
my $target = shift; my $target = shift;
my $basedir = shift; my $basedir = shift;
print "Copying $what"; print "Copying $what";
...@@ -166,14 +162,14 @@ sub CopyFiles ...@@ -166,14 +162,14 @@ sub CopyFiles
sub CopySetOfFiles sub CopySetOfFiles
{ {
my $what = shift; my $what = shift;
my $flist = shift; my $flist = shift;
my $target = shift; my $target = shift;
print "Copying $what" if $what; print "Copying $what" if $what;
foreach (@$flist) foreach (@$flist)
{ {
next if /regress/; # Skip temporary install in regression subdir next if /regress/; # Skip temporary install in regression subdir
next if /ecpg.test/; # Skip temporary install in regression subdir next if /ecpg.test/; # Skip temporary install in regression subdir
my $tgt = $target . basename($_); my $tgt = $target . basename($_);
print "."; print ".";
lcopy($_, $tgt) || croak "Could not copy $_: $!\n"; lcopy($_, $tgt) || croak "Could not copy $_: $!\n";
...@@ -183,14 +179,17 @@ sub CopySetOfFiles ...@@ -183,14 +179,17 @@ sub CopySetOfFiles
sub CopySolutionOutput sub CopySolutionOutput
{ {
my $conf = shift; my $conf = shift;
my $target = shift; my $target = shift;
my $rem = qr{Project\("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}"\) = "([^"]+)"}; my $rem =
qr{Project\("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}"\) = "([^"]+)"};
my $sln = read_file("pgsql.sln") || croak "Could not open pgsql.sln\n"; my $sln = read_file("pgsql.sln") || croak "Could not open pgsql.sln\n";
my $vcproj = 'vcproj'; my $vcproj = 'vcproj';
if ($sln =~ /Microsoft Visual Studio Solution File, Format Version (\d+)\.\d+/ && $1 >= 11) if ($sln =~
/Microsoft Visual Studio Solution File, Format Version (\d+)\.\d+/
&& $1 >= 11)
{ {
$vcproj = 'vcxproj'; $vcproj = 'vcxproj';
} }
...@@ -204,7 +203,8 @@ sub CopySolutionOutput ...@@ -204,7 +203,8 @@ sub CopySolutionOutput
$sln =~ s/$rem//; $sln =~ s/$rem//;
my $proj = read_file("$pf.$vcproj") || croak "Could not open $pf.$vcproj\n"; my $proj = read_file("$pf.$vcproj")
|| croak "Could not open $pf.$vcproj\n";
if ($vcproj eq 'vcproj' && $proj =~ qr{ConfigurationType="([^"]+)"}) if ($vcproj eq 'vcproj' && $proj =~ qr{ConfigurationType="([^"]+)"})
{ {
if ($1 == 1) if ($1 == 1)
...@@ -220,11 +220,11 @@ sub CopySolutionOutput ...@@ -220,11 +220,11 @@ sub CopySolutionOutput
else else
{ {
# Static lib, such as libpgport, only used internally during build, don't install # Static lib, such as libpgport, only used internally during build, don't install
next; next;
} }
} }
elsif ( $vcproj eq 'vcxproj' elsif ($vcproj eq 'vcxproj'
&& $proj =~ qr{<ConfigurationType>(\w+)</ConfigurationType>}) && $proj =~ qr{<ConfigurationType>(\w+)</ConfigurationType>})
{ {
if ($1 eq 'Application') if ($1 eq 'Application')
...@@ -237,10 +237,10 @@ sub CopySolutionOutput ...@@ -237,10 +237,10 @@ sub CopySolutionOutput
$dir = "lib"; $dir = "lib";
$ext = "dll"; $ext = "dll";
} }
else # 'StaticLibrary' else # 'StaticLibrary'
{ {
# Static lib, such as libpgport, only used internally during build, don't install # Static lib, such as libpgport, only used internally during build, don't install
next; next;
} }
} }
...@@ -248,9 +248,9 @@ sub CopySolutionOutput ...@@ -248,9 +248,9 @@ sub CopySolutionOutput
{ {
croak "Could not parse $pf.$vcproj\n"; croak "Could not parse $pf.$vcproj\n";
} }
lcopy("$conf\\$pf\\$pf.$ext","$target\\$dir\\$pf.$ext") lcopy("$conf\\$pf\\$pf.$ext", "$target\\$dir\\$pf.$ext")
|| croak "Could not copy $pf.$ext\n"; || croak "Could not copy $pf.$ext\n";
lcopy("$conf\\$pf\\$pf.pdb","$target\\symbols\\$pf.pdb") lcopy("$conf\\$pf\\$pf.pdb", "$target\\symbols\\$pf.pdb")
|| croak "Could not copy $pf.pdb\n"; || croak "Could not copy $pf.pdb\n";
print "."; print ".";
} }
...@@ -260,7 +260,7 @@ sub CopySolutionOutput ...@@ -260,7 +260,7 @@ sub CopySolutionOutput
sub GenerateConversionScript sub GenerateConversionScript
{ {
my $target = shift; my $target = shift;
my $sql = ""; my $sql = "";
my $F; my $F;
print "Generating conversion proc script..."; print "Generating conversion proc script...";
...@@ -268,14 +268,14 @@ sub GenerateConversionScript ...@@ -268,14 +268,14 @@ sub GenerateConversionScript
$mf =~ s{\\\s*[\r\n]+}{}mg; $mf =~ s{\\\s*[\r\n]+}{}mg;
$mf =~ /^CONVERSIONS\s*=\s*(.*)$/m $mf =~ /^CONVERSIONS\s*=\s*(.*)$/m
|| die "Could not find CONVERSIONS line in conversions Makefile\n"; || die "Could not find CONVERSIONS line in conversions Makefile\n";
my @pieces = split /\s+/,$1; my @pieces = split /\s+/, $1;
while ($#pieces > 0) while ($#pieces > 0)
{ {
my $name = shift @pieces; my $name = shift @pieces;
my $se = shift @pieces; my $se = shift @pieces;
my $de = shift @pieces; my $de = shift @pieces;
my $func = shift @pieces; my $func = shift @pieces;
my $obj = shift @pieces; my $obj = shift @pieces;
$sql .= "-- $se --> $de\n"; $sql .= "-- $se --> $de\n";
$sql .= $sql .=
"CREATE OR REPLACE FUNCTION $func (INTEGER, INTEGER, CSTRING, INTERNAL, INTEGER) RETURNS VOID AS '\$libdir/$obj', '$func' LANGUAGE C STRICT;\n"; "CREATE OR REPLACE FUNCTION $func (INTEGER, INTEGER, CSTRING, INTERNAL, INTEGER) RETURNS VOID AS '\$libdir/$obj', '$func' LANGUAGE C STRICT;\n";
...@@ -283,10 +283,11 @@ sub GenerateConversionScript ...@@ -283,10 +283,11 @@ sub GenerateConversionScript
"COMMENT ON FUNCTION $func(INTEGER, INTEGER, CSTRING, INTERNAL, INTEGER) IS 'internal conversion function for $se to $de';\n"; "COMMENT ON FUNCTION $func(INTEGER, INTEGER, CSTRING, INTERNAL, INTEGER) IS 'internal conversion function for $se to $de';\n";
$sql .= "DROP CONVERSION pg_catalog.$name;\n"; $sql .= "DROP CONVERSION pg_catalog.$name;\n";
$sql .= $sql .=
"CREATE DEFAULT CONVERSION pg_catalog.$name FOR '$se' TO '$de' FROM $func;\n"; "CREATE DEFAULT CONVERSION pg_catalog.$name FOR '$se' TO '$de' FROM $func;\n";
$sql .= "COMMENT ON CONVERSION pg_catalog.$name IS 'conversion for $se to $de';\n"; $sql .=
"COMMENT ON CONVERSION pg_catalog.$name IS 'conversion for $se to $de';\n";
} }
open($F,">$target/share/conversion_create.sql") open($F, ">$target/share/conversion_create.sql")
|| die "Could not write to conversion_create.sql\n"; || die "Could not write to conversion_create.sql\n";
print $F $sql; print $F $sql;
close($F); close($F);
...@@ -296,12 +297,13 @@ sub GenerateConversionScript ...@@ -296,12 +297,13 @@ sub GenerateConversionScript
sub GenerateTimezoneFiles sub GenerateTimezoneFiles
{ {
my $target = shift; my $target = shift;
my $conf = shift; my $conf = shift;
my $mf = read_file("src/timezone/Makefile"); my $mf = read_file("src/timezone/Makefile");
$mf =~ s{\\\s*[\r\n]+}{}mg; $mf =~ s{\\\s*[\r\n]+}{}mg;
$mf =~ /^TZDATA\s*:?=\s*(.*)$/m || die "Could not find TZDATA row in timezone makefile\n"; $mf =~ /^TZDATA\s*:?=\s*(.*)$/m
my @tzfiles = split /\s+/,$1; || die "Could not find TZDATA row in timezone makefile\n";
unshift @tzfiles,''; my @tzfiles = split /\s+/, $1;
unshift @tzfiles, '';
print "Generating timezone files..."; print "Generating timezone files...";
system("$conf\\zic\\zic -d \"$target/share/timezone\" " system("$conf\\zic\\zic -d \"$target/share/timezone\" "
. join(" src/timezone/data/", @tzfiles)); . join(" src/timezone/data/", @tzfiles));
...@@ -315,21 +317,21 @@ sub GenerateTsearchFiles ...@@ -315,21 +317,21 @@ sub GenerateTsearchFiles
print "Generating tsearch script..."; print "Generating tsearch script...";
my $F; my $F;
my $tmpl = read_file('src/backend/snowball/snowball.sql.in'); my $tmpl = read_file('src/backend/snowball/snowball.sql.in');
my $mf = read_file('src/backend/snowball/Makefile'); my $mf = read_file('src/backend/snowball/Makefile');
$mf =~ s{\\\s*[\r\n]+}{}mg; $mf =~ s{\\\s*[\r\n]+}{}mg;
$mf =~ /^LANGUAGES\s*=\s*(.*)$/m $mf =~ /^LANGUAGES\s*=\s*(.*)$/m
|| die "Could not find LANGUAGES line in snowball Makefile\n"; || die "Could not find LANGUAGES line in snowball Makefile\n";
my @pieces = split /\s+/,$1; my @pieces = split /\s+/, $1;
open($F,">$target/share/snowball_create.sql") open($F, ">$target/share/snowball_create.sql")
|| die "Could not write snowball_create.sql"; || die "Could not write snowball_create.sql";
print $F read_file('src/backend/snowball/snowball_func.sql.in'); print $F read_file('src/backend/snowball/snowball_func.sql.in');
while ($#pieces > 0) while ($#pieces > 0)
{ {
my $lang = shift @pieces || last; my $lang = shift @pieces || last;
my $asclang = shift @pieces || last; my $asclang = shift @pieces || last;
my $txt = $tmpl; my $txt = $tmpl;
my $stop = ''; my $stop = '';
if (-s "src/backend/snowball/stopwords/$lang.stop") if (-s "src/backend/snowball/stopwords/$lang.stop")
{ {
...@@ -361,9 +363,9 @@ sub CopyContribFiles ...@@ -361,9 +363,9 @@ sub CopyContribFiles
{ {
next if ($d =~ /^\./); next if ($d =~ /^\./);
next unless (-f "contrib/$d/Makefile"); next unless (-f "contrib/$d/Makefile");
next if ($d eq "uuid-ossp"&& !defined($config->{uuid})); next if ($d eq "uuid-ossp" && !defined($config->{uuid}));
next if ($d eq "sslinfo" && !defined($config->{openssl})); next if ($d eq "sslinfo" && !defined($config->{openssl}));
next if ($d eq "xml2" && !defined($config->{xml})); next if ($d eq "xml2" && !defined($config->{xml}));
next if ($d eq "sepgsql"); next if ($d eq "sepgsql");
my $mf = read_file("contrib/$d/Makefile"); my $mf = read_file("contrib/$d/Makefile");
...@@ -373,32 +375,32 @@ sub CopyContribFiles ...@@ -373,32 +375,32 @@ sub CopyContribFiles
my $moduledir = 'contrib'; my $moduledir = 'contrib';
my $flist = ''; my $flist = '';
if ($mf =~ /^EXTENSION\s*=\s*(.*)$/m) {$flist .= $1} if ($mf =~ /^EXTENSION\s*=\s*(.*)$/m) { $flist .= $1 }
if ($flist ne '') if ($flist ne '')
{ {
$moduledir = 'extension'; $moduledir = 'extension';
$flist = ParseAndCleanRule($flist, $mf); $flist = ParseAndCleanRule($flist, $mf);
foreach my $f (split /\s+/,$flist) foreach my $f (split /\s+/, $flist)
{ {
lcopy( lcopy(
'contrib/' . $d . '/' . $f . '.control', 'contrib/' . $d . '/' . $f . '.control',
$target . '/share/extension/' . $f . '.control' $target . '/share/extension/' . $f . '.control'
)|| croak("Could not copy file $f.control in contrib $d"); ) || croak("Could not copy file $f.control in contrib $d");
print '.'; print '.';
} }
} }
$flist = ''; $flist = '';
if ($mf =~ /^DATA_built\s*=\s*(.*)$/m) {$flist .= $1} if ($mf =~ /^DATA_built\s*=\s*(.*)$/m) { $flist .= $1 }
if ($mf =~ /^DATA\s*=\s*(.*)$/m) {$flist .= " $1"} if ($mf =~ /^DATA\s*=\s*(.*)$/m) { $flist .= " $1" }
$flist =~ s/^\s*//; # Remove leading spaces if we had only DATA_built $flist =~ s/^\s*//; # Remove leading spaces if we had only DATA_built
if ($flist ne '') if ($flist ne '')
{ {
$flist = ParseAndCleanRule($flist, $mf); $flist = ParseAndCleanRule($flist, $mf);
foreach my $f (split /\s+/,$flist) foreach my $f (split /\s+/, $flist)
{ {
lcopy('contrib/' . $d . '/' . $f, lcopy('contrib/' . $d . '/' . $f,
$target . '/share/' . $moduledir . '/' . basename($f)) $target . '/share/' . $moduledir . '/' . basename($f))
...@@ -408,12 +410,12 @@ sub CopyContribFiles ...@@ -408,12 +410,12 @@ sub CopyContribFiles
} }
$flist = ''; $flist = '';
if ($mf =~ /^DATA_TSEARCH\s*=\s*(.*)$/m) {$flist .= $1} if ($mf =~ /^DATA_TSEARCH\s*=\s*(.*)$/m) { $flist .= $1 }
if ($flist ne '') if ($flist ne '')
{ {
$flist = ParseAndCleanRule($flist, $mf); $flist = ParseAndCleanRule($flist, $mf);
foreach my $f (split /\s+/,$flist) foreach my $f (split /\s+/, $flist)
{ {
lcopy('contrib/' . $d . '/' . $f, lcopy('contrib/' . $d . '/' . $f,
$target . '/share/tsearch_data/' . basename($f)) $target . '/share/tsearch_data/' . basename($f))
...@@ -423,7 +425,7 @@ sub CopyContribFiles ...@@ -423,7 +425,7 @@ sub CopyContribFiles
} }
$flist = ''; $flist = '';
if ($mf =~ /^DOCS\s*=\s*(.*)$/mg) {$flist .= $1} if ($mf =~ /^DOCS\s*=\s*(.*)$/mg) { $flist .= $1 }
if ($flist ne '') if ($flist ne '')
{ {
$flist = ParseAndCleanRule($flist, $mf); $flist = ParseAndCleanRule($flist, $mf);
...@@ -432,7 +434,7 @@ sub CopyContribFiles ...@@ -432,7 +434,7 @@ sub CopyContribFiles
$flist = $flist =
"autoinc.example insert_username.example moddatetime.example refint.example timetravel.example" "autoinc.example insert_username.example moddatetime.example refint.example timetravel.example"
if ($d eq 'spi'); if ($d eq 'spi');
foreach my $f (split /\s+/,$flist) foreach my $f (split /\s+/, $flist)
{ {
lcopy('contrib/' . $d . '/' . $f, lcopy('contrib/' . $d . '/' . $f,
$target . '/doc/' . $moduledir . '/' . $f) $target . '/doc/' . $moduledir . '/' . $f)
...@@ -448,20 +450,25 @@ sub CopyContribFiles ...@@ -448,20 +450,25 @@ sub CopyContribFiles
sub ParseAndCleanRule sub ParseAndCleanRule
{ {
my $flist = shift; my $flist = shift;
my $mf = shift; my $mf = shift;
# Strip out $(addsuffix) rules # Strip out $(addsuffix) rules
if (index($flist, '$(addsuffix ') >= 0) if (index($flist, '$(addsuffix ') >= 0)
{ {
my $pcount = 0; my $pcount = 0;
my $i; my $i;
for ($i = index($flist, '$(addsuffix ') + 12; $i < length($flist); $i++) for (
$i = index($flist, '$(addsuffix ') + 12;
$i < length($flist);
$i++)
{ {
$pcount++ if (substr($flist, $i, 1) eq '('); $pcount++ if (substr($flist, $i, 1) eq '(');
$pcount-- if (substr($flist, $i, 1) eq ')'); $pcount-- if (substr($flist, $i, 1) eq ')');
last if ($pcount < 0); last if ($pcount < 0);
} }
$flist = substr($flist, 0, index($flist, '$(addsuffix ')) . substr($flist, $i+1); $flist =
substr($flist, 0, index($flist, '$(addsuffix '))
. substr($flist, $i + 1);
} }
return $flist; return $flist;
} }
...@@ -470,56 +477,52 @@ sub CopyIncludeFiles ...@@ -470,56 +477,52 @@ sub CopyIncludeFiles
{ {
my $target = shift; my $target = shift;
EnsureDirectories($target, 'include', 'include/libpq','include/internal', EnsureDirectories($target, 'include', 'include/libpq', 'include/internal',
'include/internal/libpq','include/server', 'include/server/parser'); 'include/internal/libpq', 'include/server', 'include/server/parser');
CopyFiles( CopyFiles(
'Public headers', 'Public headers',
$target . '/include/', $target . '/include/',
'src/include/', 'postgres_ext.h', 'pg_config.h', 'pg_config_os.h', 'src/include/', 'postgres_ext.h', 'pg_config.h', 'pg_config_os.h',
'pg_config_manual.h' 'pg_config_manual.h');
);
lcopy('src/include/libpq/libpq-fs.h', $target . '/include/libpq/') lcopy('src/include/libpq/libpq-fs.h', $target . '/include/libpq/')
|| croak 'Could not copy libpq-fs.h'; || croak 'Could not copy libpq-fs.h';
CopyFiles( CopyFiles(
'Libpq headers', 'Libpq headers',
$target . '/include/', $target . '/include/',
'src/interfaces/libpq/','libpq-fe.h', 'libpq-events.h' 'src/interfaces/libpq/', 'libpq-fe.h', 'libpq-events.h');
);
CopyFiles( CopyFiles(
'Libpq internal headers', 'Libpq internal headers',
$target .'/include/internal/', $target . '/include/internal/',
'src/interfaces/libpq/', 'libpq-int.h', 'pqexpbuffer.h' 'src/interfaces/libpq/', 'libpq-int.h', 'pqexpbuffer.h');
);
CopyFiles( CopyFiles(
'Internal headers', 'Internal headers',
$target . '/include/internal/', $target . '/include/internal/',
'src/include/', 'c.h', 'port.h', 'postgres_fe.h' 'src/include/', 'c.h', 'port.h', 'postgres_fe.h');
);
lcopy('src/include/libpq/pqcomm.h', $target . '/include/internal/libpq/') lcopy('src/include/libpq/pqcomm.h', $target . '/include/internal/libpq/')
|| croak 'Could not copy pqcomm.h'; || croak 'Could not copy pqcomm.h';
CopyFiles( CopyFiles(
'Server headers', 'Server headers',
$target . '/include/server/', $target . '/include/server/',
'src/include/', 'pg_config.h', 'pg_config_os.h' 'src/include/', 'pg_config.h', 'pg_config_os.h');
);
CopyFiles( CopyFiles(
'Grammar header', 'Grammar header',
$target . '/include/server/parser/', $target . '/include/server/parser/',
'src/backend/parser/','gram.h' 'src/backend/parser/', 'gram.h');
); CopySetOfFiles(
CopySetOfFiles('',[ glob("src\\include\\*.h") ],$target . '/include/server/'); '',
[ glob("src\\include\\*.h") ],
$target . '/include/server/');
my $D; my $D;
opendir($D, 'src/include') || croak "Could not opendir on src/include!\n"; opendir($D, 'src/include') || croak "Could not opendir on src/include!\n";
CopyFiles( CopyFiles(
'PL/pgSQL header', 'PL/pgSQL header',
$target . '/include/server/', $target . '/include/server/',
'src/pl/plpgsql/src/', 'plpgsql.h' 'src/pl/plpgsql/src/', 'plpgsql.h');
);
# some xcopy progs don't like mixed slash style paths # some xcopy progs don't like mixed slash style paths
(my $ctarget = $target) =~ s!/!\\!g; (my $ctarget = $target) =~ s!/!\\!g;
...@@ -533,47 +536,45 @@ sub CopyIncludeFiles ...@@ -533,47 +536,45 @@ sub CopyIncludeFiles
EnsureDirectories("$target/include/server/$d"); EnsureDirectories("$target/include/server/$d");
system( system(
qq{xcopy /s /i /q /r /y src\\include\\$d\\*.h "$ctarget\\include\\server\\$d\\"} qq{xcopy /s /i /q /r /y src\\include\\$d\\*.h "$ctarget\\include\\server\\$d\\"}
)&& croak("Failed to copy include directory $d\n"); ) && croak("Failed to copy include directory $d\n");
} }
closedir($D); closedir($D);
my $mf = read_file('src/interfaces/ecpg/include/Makefile'); my $mf = read_file('src/interfaces/ecpg/include/Makefile');
$mf =~ s{\\s*[\r\n]+}{}mg; $mf =~ s{\\s*[\r\n]+}{}mg;
$mf =~ /^ecpg_headers\s*=\s*(.*)$/m || croak "Could not find ecpg_headers line\n"; $mf =~ /^ecpg_headers\s*=\s*(.*)$/m
|| croak "Could not find ecpg_headers line\n";
CopyFiles( CopyFiles(
'ECPG headers', 'ECPG headers',
$target . '/include/', $target . '/include/',
'src/interfaces/ecpg/include/', 'src/interfaces/ecpg/include/',
'ecpg_config.h', split /\s+/,$1 'ecpg_config.h', split /\s+/, $1);
); $mf =~ /^informix_headers\s*=\s*(.*)$/m
$mf =~ /^informix_headers\s*=\s*(.*)$/m || croak "Could not find informix_headers line\n"; || croak "Could not find informix_headers line\n";
EnsureDirectories($target . '/include', 'informix', 'informix/esql'); EnsureDirectories($target . '/include', 'informix', 'informix/esql');
CopyFiles( CopyFiles(
'ECPG informix headers', 'ECPG informix headers',
$target .'/include/informix/esql/', $target . '/include/informix/esql/',
'src/interfaces/ecpg/include/', 'src/interfaces/ecpg/include/',
split /\s+/,$1 split /\s+/, $1);
);
} }
sub GenerateNLSFiles sub GenerateNLSFiles
{ {
my $target = shift; my $target = shift;
my $nlspath = shift; my $nlspath = shift;
my $majorver = shift; my $majorver = shift;
print "Installing NLS files..."; print "Installing NLS files...";
EnsureDirectories($target, "share/locale"); EnsureDirectories($target, "share/locale");
my @flist; my @flist;
File::Find::find( File::Find::find(
{ { wanted => sub {
wanted =>sub {
/^nls\.mk\z/s /^nls\.mk\z/s
&&!push(@flist, $File::Find::name); && !push(@flist, $File::Find::name);
} }
}, },
"src" "src");
);
foreach (@flist) foreach (@flist)
{ {
my $prgm = DetermineCatalogName($_); my $prgm = DetermineCatalogName($_);
...@@ -590,7 +591,7 @@ sub GenerateNLSFiles ...@@ -590,7 +591,7 @@ sub GenerateNLSFiles
"share/locale/$lang/LC_MESSAGES"); "share/locale/$lang/LC_MESSAGES");
system( system(
"\"$nlspath\\bin\\msgfmt\" -o \"$target\\share\\locale\\$lang\\LC_MESSAGES\\$prgm-$majorver.mo\" $_" "\"$nlspath\\bin\\msgfmt\" -o \"$target\\share\\locale\\$lang\\LC_MESSAGES\\$prgm-$majorver.mo\" $_"
)&& croak("Could not run msgfmt on $dir\\$_"); ) && croak("Could not run msgfmt on $dir\\$_");
print "."; print ".";
} }
} }
...@@ -599,7 +600,8 @@ sub GenerateNLSFiles ...@@ -599,7 +600,8 @@ sub GenerateNLSFiles
sub DetermineMajorVersion sub DetermineMajorVersion
{ {
my $f = read_file('src/include/pg_config.h') || croak 'Could not open pg_config.h'; my $f = read_file('src/include/pg_config.h')
|| croak 'Could not open pg_config.h';
$f =~ /^#define\s+PG_MAJORVERSION\s+"([^"]+)"/m $f =~ /^#define\s+PG_MAJORVERSION\s+"([^"]+)"/m
|| croak 'Could not determine major version'; || croak 'Could not determine major version';
return $1; return $1;
......
src/tools/msvc/MSBuildProject.pm
View file @ 042d9ffc
...@@ -14,7 +14,7 @@ use base qw(Project); ...@@ -14,7 +14,7 @@ use base qw(Project);
sub _new sub _new
{ {
my $classname = shift; my $classname = shift;
my $self = $classname->SUPER::_new(@_); my $self = $classname->SUPER::_new(@_);
bless($self, $classname); bless($self, $classname);
$self->{filenameExtension} = '.vcxproj'; $self->{filenameExtension} = '.vcxproj';
...@@ -40,8 +40,10 @@ EOF ...@@ -40,8 +40,10 @@ EOF
</PropertyGroup> </PropertyGroup>
<Import Project="\$(VCTargetsPath)\\Microsoft.Cpp.Default.props" /> <Import Project="\$(VCTargetsPath)\\Microsoft.Cpp.Default.props" />
EOF EOF
$self->WriteConfigurationPropertyGroup($f, 'Release',{wholeopt=>'false'}); $self->WriteConfigurationPropertyGroup($f, 'Release',
$self->WriteConfigurationPropertyGroup($f, 'Debug',{wholeopt=>'false'}); { wholeopt => 'false' });
$self->WriteConfigurationPropertyGroup($f, 'Debug',
{ wholeopt => 'false' });
print $f <<EOF; print $f <<EOF;
<Import Project="\$(VCTargetsPath)\\Microsoft.Cpp.props" /> <Import Project="\$(VCTargetsPath)\\Microsoft.Cpp.props" />
<ImportGroup Label="ExtensionSettings"> <ImportGroup Label="ExtensionSettings">
...@@ -61,15 +63,17 @@ EOF ...@@ -61,15 +63,17 @@ EOF
EOF EOF
$self->WriteItemDefinitionGroup( $self->WriteItemDefinitionGroup(
$f, 'Debug', $f, 'Debug',
{ { defs => '_DEBUG;DEBUG=1;',
defs=>'_DEBUG;DEBUG=1;', opt => 'Disabled',
opt=>'Disabled', strpool => 'false',
strpool=>'false', runtime => 'MultiThreadedDebugDLL' });
runtime=>'MultiThreadedDebugDLL' $self->WriteItemDefinitionGroup(
} $f,
); 'Release',
$self->WriteItemDefinitionGroup($f, 'Release', { defs => '',
{defs=>'', opt=>'Full', strpool=>'true', runtime=>'MultiThreadedDLL'}); opt => 'Full',
strpool => 'true',
runtime => 'MultiThreadedDLL' });
} }
sub AddDefine sub AddDefine
...@@ -83,7 +87,7 @@ sub WriteReferences ...@@ -83,7 +87,7 @@ sub WriteReferences
{ {
my ($self, $f) = @_; my ($self, $f) = @_;
my @references = @{$self->{references}}; my @references = @{ $self->{references} };
if (scalar(@references)) if (scalar(@references))
{ {
...@@ -110,14 +114,14 @@ sub WriteFiles ...@@ -110,14 +114,14 @@ sub WriteFiles
print $f <<EOF; print $f <<EOF;
<ItemGroup> <ItemGroup>
EOF EOF
my @grammarFiles = (); my @grammarFiles = ();
my @resourceFiles = (); my @resourceFiles = ();
my %uniquefiles; my %uniquefiles;
foreach my $fileNameWithPath (sort keys %{$self->{files}}) foreach my $fileNameWithPath (sort keys %{ $self->{files} })
{ {
confess "Bad format filename '$fileNameWithPath'\n" confess "Bad format filename '$fileNameWithPath'\n"
unless ($fileNameWithPath =~ /^(.*)\\([^\\]+)\.[r]?[cyl]$/); unless ($fileNameWithPath =~ /^(.*)\\([^\\]+)\.[r]?[cyl]$/);
my $dir = $1; my $dir = $1;
my $fileName = $2; my $fileName = $2;
if ($fileNameWithPath =~ /\.y$/ or $fileNameWithPath =~ /\.l$/) if ($fileNameWithPath =~ /\.y$/ or $fileNameWithPath =~ /\.l$/)
{ {
...@@ -178,7 +182,7 @@ s{^src\\pl\\plpgsql\\src\\gram.c$}{src\\pl\\plpgsql\\src\\pl_gram.c}; ...@@ -178,7 +182,7 @@ s{^src\\pl\\plpgsql\\src\\gram.c$}{src\\pl\\plpgsql\\src\\pl_gram.c};
</CustomBuild> </CustomBuild>
EOF EOF
} }
else #if ($grammarFile =~ /\.l$/) else #if ($grammarFile =~ /\.l$/)
{ {
print $f <<EOF; print $f <<EOF;
<CustomBuild Include="$grammarFile"> <CustomBuild Include="$grammarFile">
...@@ -231,8 +235,8 @@ sub WriteConfigurationPropertyGroup ...@@ -231,8 +235,8 @@ sub WriteConfigurationPropertyGroup
my ($self, $f, $cfgname, $p) = @_; my ($self, $f, $cfgname, $p) = @_;
my $cfgtype = my $cfgtype =
($self->{type} eq "exe") ($self->{type} eq "exe")
?'Application' ? 'Application'
:($self->{type} eq "dll"?'DynamicLibrary':'StaticLibrary'); : ($self->{type} eq "dll" ? 'DynamicLibrary' : 'StaticLibrary');
print $f <<EOF; print $f <<EOF;
<PropertyGroup Condition="'\$(Configuration)|\$(Platform)'=='$cfgname|$self->{platform}'" Label="Configuration"> <PropertyGroup Condition="'\$(Configuration)|\$(Platform)'=='$cfgname|$self->{platform}'" Label="Configuration">
...@@ -269,11 +273,12 @@ sub WriteItemDefinitionGroup ...@@ -269,11 +273,12 @@ sub WriteItemDefinitionGroup
my ($self, $f, $cfgname, $p) = @_; my ($self, $f, $cfgname, $p) = @_;
my $cfgtype = my $cfgtype =
($self->{type} eq "exe") ($self->{type} eq "exe")
?'Application' ? 'Application'
:($self->{type} eq "dll"?'DynamicLibrary':'StaticLibrary'); : ($self->{type} eq "dll" ? 'DynamicLibrary' : 'StaticLibrary');
my $libs = $self->GetAdditionalLinkerDependencies($cfgname, ';'); my $libs = $self->GetAdditionalLinkerDependencies($cfgname, ';');
my $targetmachine = $self->{platform} eq 'Win32' ? 'MachineX86' : 'MachineX64'; my $targetmachine =
$self->{platform} eq 'Win32' ? 'MachineX86' : 'MachineX64';
my $includes = $self->{includes}; my $includes = $self->{includes};
unless ($includes eq '' or $includes =~ /;$/) unless ($includes eq '' or $includes =~ /;$/)
...@@ -378,7 +383,7 @@ use base qw(MSBuildProject); ...@@ -378,7 +383,7 @@ use base qw(MSBuildProject);
sub new sub new
{ {
my $classname = shift; my $classname = shift;
my $self = $classname->SUPER::_new(@_); my $self = $classname->SUPER::_new(@_);
bless($self, $classname); bless($self, $classname);
$self->{vcver} = '10.00'; $self->{vcver} = '10.00';
......
src/tools/msvc/Mkvcbuild.pm
View file @ 042d9ffc
...@@ -19,7 +19,7 @@ use List::Util qw(first); ...@@ -19,7 +19,7 @@ use List::Util qw(first);
use Exporter; use Exporter;
our (@ISA, @EXPORT_OK); our (@ISA, @EXPORT_OK);
@ISA = qw(Exporter); @ISA = qw(Exporter);
@EXPORT_OK = qw(Mkvcbuild); @EXPORT_OK = qw(Mkvcbuild);
my $solution; my $solution;
...@@ -27,26 +27,29 @@ my $libpgport; ...@@ -27,26 +27,29 @@ my $libpgport;
my $postgres; my $postgres;
my $libpq; my $libpq;
my $contrib_defines = {'refint' => 'REFINT_VERBOSE'}; my $contrib_defines = { 'refint' => 'REFINT_VERBOSE' };
my @contrib_uselibpq = ('dblink', 'oid2name', 'pgbench', 'pg_upgrade','vacuumlo'); my @contrib_uselibpq =
my @contrib_uselibpgport =( ('dblink', 'oid2name', 'pgbench', 'pg_upgrade', 'vacuumlo');
'oid2name', 'pgbench', 'pg_standby','pg_archivecleanup', my @contrib_uselibpgport = (
'pg_test_fsync', 'pg_test_timing', 'pg_upgrade', 'vacuumlo' 'oid2name', 'pgbench',
); 'pg_standby', 'pg_archivecleanup',
my $contrib_extralibs = {'pgbench' => ['wsock32.lib']}; 'pg_test_fsync', 'pg_test_timing',
my $contrib_extraincludes = {'tsearch2' => ['contrib/tsearch2'], 'dblink' => ['src/backend']}; 'pg_upgrade', 'vacuumlo');
my $contrib_extralibs = { 'pgbench' => ['wsock32.lib'] };
my $contrib_extraincludes =
{ 'tsearch2' => ['contrib/tsearch2'], 'dblink' => ['src/backend'] };
my $contrib_extrasource = { my $contrib_extrasource = {
'cube' => ['cubescan.l','cubeparse.y'], 'cube' => [ 'cubescan.l', 'cubeparse.y' ],
'seg' => ['segscan.l','segparse.y'] 'seg' => [ 'segscan.l', 'segparse.y' ] };
}; my @contrib_excludes = ('pgcrypto', 'intagg', 'sepgsql');
my @contrib_excludes = ('pgcrypto','intagg','sepgsql');
sub mkvcbuild sub mkvcbuild
{ {
our $config = shift; our $config = shift;
chdir('..\..\..') if (-d '..\msvc' && -d '..\..\..\src'); chdir('..\..\..') if (-d '..\msvc' && -d '..\..\..\src');
die 'Must run from root or msvc directory' unless (-d 'src\tools\msvc' && -d 'src'); die 'Must run from root or msvc directory'
unless (-d 'src\tools\msvc' && -d 'src');
my $vsVersion = DetermineVisualStudioVersion(); my $vsVersion = DetermineVisualStudioVersion();
...@@ -60,24 +63,31 @@ sub mkvcbuild ...@@ -60,24 +63,31 @@ sub mkvcbuild
sprompt.c thread.c getopt.c getopt_long.c dirent.c rint.c win32env.c sprompt.c thread.c getopt.c getopt_long.c dirent.c rint.c win32env.c
win32error.c win32setlocale.c); win32error.c win32setlocale.c);
$libpgport = $solution->AddProject('libpgport','lib','misc'); $libpgport = $solution->AddProject('libpgport', 'lib', 'misc');
$libpgport->AddDefine('FRONTEND'); $libpgport->AddDefine('FRONTEND');
$libpgport->AddFiles('src\port',@pgportfiles); $libpgport->AddFiles('src\port', @pgportfiles);
$postgres = $solution->AddProject('postgres','exe','','src\backend'); $postgres = $solution->AddProject('postgres', 'exe', '', 'src\backend');
$postgres->AddIncludeDir('src\backend'); $postgres->AddIncludeDir('src\backend');
$postgres->AddDir('src\backend\port\win32'); $postgres->AddDir('src\backend\port\win32');
$postgres->AddFile('src\backend\utils\fmgrtab.c'); $postgres->AddFile('src\backend\utils\fmgrtab.c');
$postgres->ReplaceFile('src\backend\port\dynloader.c','src\backend\port\dynloader\win32.c'); $postgres->ReplaceFile(
$postgres->ReplaceFile('src\backend\port\pg_sema.c','src\backend\port\win32_sema.c'); 'src\backend\port\dynloader.c',
$postgres->ReplaceFile('src\backend\port\pg_shmem.c','src\backend\port\win32_shmem.c'); 'src\backend\port\dynloader\win32.c');
$postgres->ReplaceFile('src\backend\port\pg_latch.c','src\backend\port\win32_latch.c'); $postgres->ReplaceFile('src\backend\port\pg_sema.c',
$postgres->AddFiles('src\port',@pgportfiles); 'src\backend\port\win32_sema.c');
$postgres->ReplaceFile('src\backend\port\pg_shmem.c',
'src\backend\port\win32_shmem.c');
$postgres->ReplaceFile('src\backend\port\pg_latch.c',
'src\backend\port\win32_latch.c');
$postgres->AddFiles('src\port', @pgportfiles);
$postgres->AddDir('src\timezone'); $postgres->AddDir('src\timezone');
$postgres->AddFiles('src\backend\parser','scan.l','gram.y'); $postgres->AddFiles('src\backend\parser', 'scan.l', 'gram.y');
$postgres->AddFiles('src\backend\bootstrap','bootscanner.l','bootparse.y'); $postgres->AddFiles('src\backend\bootstrap', 'bootscanner.l',
$postgres->AddFiles('src\backend\utils\misc','guc-file.l'); 'bootparse.y');
$postgres->AddFiles('src\backend\replication', 'repl_scanner.l', 'repl_gram.y'); $postgres->AddFiles('src\backend\utils\misc', 'guc-file.l');
$postgres->AddFiles('src\backend\replication', 'repl_scanner.l',
'repl_gram.y');
$postgres->AddDefine('BUILDING_DLL'); $postgres->AddDefine('BUILDING_DLL');
$postgres->AddLibrary('wsock32.lib'); $postgres->AddLibrary('wsock32.lib');
$postgres->AddLibrary('ws2_32.lib'); $postgres->AddLibrary('ws2_32.lib');
...@@ -85,34 +95,36 @@ sub mkvcbuild ...@@ -85,34 +95,36 @@ sub mkvcbuild
$postgres->AddLibrary('wldap32.lib') if ($solution->{options}->{ldap}); $postgres->AddLibrary('wldap32.lib') if ($solution->{options}->{ldap});
$postgres->FullExportDLL('postgres.lib'); $postgres->FullExportDLL('postgres.lib');
my $snowball = $solution->AddProject('dict_snowball','dll','','src\backend\snowball'); my $snowball = $solution->AddProject('dict_snowball', 'dll', '',
'src\backend\snowball');
$snowball->RelocateFiles( $snowball->RelocateFiles(
'src\backend\snowball\libstemmer', 'src\backend\snowball\libstemmer',
sub { sub {
return shift !~ /dict_snowball.c$/; return shift !~ /dict_snowball.c$/;
} });
);
$snowball->AddIncludeDir('src\include\snowball'); $snowball->AddIncludeDir('src\include\snowball');
$snowball->AddReference($postgres); $snowball->AddReference($postgres);
my $plpgsql = $solution->AddProject('plpgsql','dll','PLs','src\pl\plpgsql\src'); my $plpgsql =
$solution->AddProject('plpgsql', 'dll', 'PLs', 'src\pl\plpgsql\src');
$plpgsql->AddFiles('src\pl\plpgsql\src', 'gram.y'); $plpgsql->AddFiles('src\pl\plpgsql\src', 'gram.y');
$plpgsql->AddReference($postgres); $plpgsql->AddReference($postgres);
if ($solution->{options}->{perl}) if ($solution->{options}->{perl})
{ {
my $plperlsrc = "src\\pl\\plperl\\"; my $plperlsrc = "src\\pl\\plperl\\";
my $plperl = $solution->AddProject('plperl','dll','PLs','src\pl\plperl'); my $plperl =
$solution->AddProject('plperl', 'dll', 'PLs', 'src\pl\plperl');
$plperl->AddIncludeDir($solution->{options}->{perl} . '/lib/CORE'); $plperl->AddIncludeDir($solution->{options}->{perl} . '/lib/CORE');
$plperl->AddDefine('PLPERL_HAVE_UID_GID'); $plperl->AddDefine('PLPERL_HAVE_UID_GID');
foreach my $xs ('SPI.xs', 'Util.xs') foreach my $xs ('SPI.xs', 'Util.xs')
{ {
(my $xsc = $xs) =~ s/\.xs/.c/; (my $xsc = $xs) =~ s/\.xs/.c/;
if (Solution::IsNewer("$plperlsrc$xsc","$plperlsrc$xs")) if (Solution::IsNewer("$plperlsrc$xsc", "$plperlsrc$xs"))
{ {
my $xsubppdir = first { -e "$_\\ExtUtils\\xsubpp" } @INC; my $xsubppdir = first { -e "$_\\ExtUtils\\xsubpp" } @INC;
print "Building $plperlsrc$xsc...\n"; print "Building $plperlsrc$xsc...\n";
system( $solution->{options}->{perl} system( $solution->{options}->{perl}
. '/bin/perl ' . '/bin/perl '
. "$xsubppdir/ExtUtils/xsubpp -typemap " . "$xsubppdir/ExtUtils/xsubpp -typemap "
. $solution->{options}->{perl} . $solution->{options}->{perl}
...@@ -121,60 +133,58 @@ sub mkvcbuild ...@@ -121,60 +133,58 @@ sub mkvcbuild
. ">$plperlsrc$xsc"); . ">$plperlsrc$xsc");
if ((!(-f "$plperlsrc$xsc")) || -z "$plperlsrc$xsc") if ((!(-f "$plperlsrc$xsc")) || -z "$plperlsrc$xsc")
{ {
unlink("$plperlsrc$xsc"); # if zero size unlink("$plperlsrc$xsc"); # if zero size
die "Failed to create $xsc.\n"; die "Failed to create $xsc.\n";
} }
} }
} }
if ( if (Solution::IsNewer(
Solution::IsNewer('src\pl\plperl\perlchunks.h', 'src\pl\plperl\perlchunks.h',
'src\pl\plperl\plc_perlboot.pl') 'src\pl\plperl\plc_perlboot.pl')
||Solution::IsNewer( || Solution::IsNewer(
'src\pl\plperl\perlchunks.h','src\pl\plperl\plc_trusted.pl' 'src\pl\plperl\perlchunks.h',
) 'src\pl\plperl\plc_trusted.pl'))
)
{ {
print 'Building src\pl\plperl\perlchunks.h ...' . "\n"; print 'Building src\pl\plperl\perlchunks.h ...' . "\n";
my $basedir = getcwd; my $basedir = getcwd;
chdir 'src\pl\plperl'; chdir 'src\pl\plperl';
system( $solution->{options}->{perl} system( $solution->{options}->{perl}
. '/bin/perl ' . '/bin/perl '
. 'text2macro.pl ' . 'text2macro.pl '
. '--strip="^(\#.*|\s*)$$" ' . '--strip="^(\#.*|\s*)$$" '
. 'plc_perlboot.pl plc_trusted.pl ' . 'plc_perlboot.pl plc_trusted.pl '
. '>perlchunks.h'); . '>perlchunks.h');
chdir $basedir; chdir $basedir;
if ((!(-f 'src\pl\plperl\perlchunks.h')) || -z 'src\pl\plperl\perlchunks.h') if ((!(-f 'src\pl\plperl\perlchunks.h'))
|| -z 'src\pl\plperl\perlchunks.h')
{ {
unlink('src\pl\plperl\perlchunks.h'); # if zero size unlink('src\pl\plperl\perlchunks.h'); # if zero size
die 'Failed to create perlchunks.h' . "\n"; die 'Failed to create perlchunks.h' . "\n";
} }
} }
if ( if (Solution::IsNewer(
Solution::IsNewer(
'src\pl\plperl\plperl_opmask.h', 'src\pl\plperl\plperl_opmask.h',
'src\pl\plperl\plperl_opmask.pl' 'src\pl\plperl\plperl_opmask.pl'))
)
)
{ {
print 'Building src\pl\plperl\plperl_opmask.h ...' . "\n"; print 'Building src\pl\plperl\plperl_opmask.h ...' . "\n";
my $basedir = getcwd; my $basedir = getcwd;
chdir 'src\pl\plperl'; chdir 'src\pl\plperl';
system( $solution->{options}->{perl} system( $solution->{options}->{perl}
. '/bin/perl ' . '/bin/perl '
. 'plperl_opmask.pl ' . 'plperl_opmask.pl '
. 'plperl_opmask.h'); . 'plperl_opmask.h');
chdir $basedir; chdir $basedir;
if ((!(-f 'src\pl\plperl\plperl_opmask.h')) if ((!(-f 'src\pl\plperl\plperl_opmask.h'))
|| -z 'src\pl\plperl\plperl_opmask.h') || -z 'src\pl\plperl\plperl_opmask.h')
{ {
unlink('src\pl\plperl\plperl_opmask.h'); # if zero size unlink('src\pl\plperl\plperl_opmask.h'); # if zero size
die 'Failed to create plperl_opmask.h' . "\n"; die 'Failed to create plperl_opmask.h' . "\n";
} }
} }
$plperl->AddReference($postgres); $plperl->AddReference($postgres);
my @perl_libs = my @perl_libs =
grep {/perl\d+.lib$/ }glob($solution->{options}->{perl} . '\lib\CORE\perl*.lib'); grep { /perl\d+.lib$/ }
glob($solution->{options}->{perl} . '\lib\CORE\perl*.lib');
if (@perl_libs == 1) if (@perl_libs == 1)
{ {
$plperl->AddLibrary($perl_libs[0]); $plperl->AddLibrary($perl_libs[0]);
...@@ -206,8 +216,8 @@ sub mkvcbuild ...@@ -206,8 +216,8 @@ sub mkvcbuild
if (!(defined($pyprefix) && defined($pyver))); if (!(defined($pyprefix) && defined($pyver)));
my $pymajorver = substr($pyver, 0, 1); my $pymajorver = substr($pyver, 0, 1);
my $plpython = my $plpython = $solution->AddProject('plpython' . $pymajorver,
$solution->AddProject('plpython' . $pymajorver, 'dll','PLs', 'src\pl\plpython'); 'dll', 'PLs', 'src\pl\plpython');
$plpython->AddIncludeDir($pyprefix . '\include'); $plpython->AddIncludeDir($pyprefix . '\include');
$plpython->AddLibrary($pyprefix . "\\Libs\\python$pyver.lib"); $plpython->AddLibrary($pyprefix . "\\Libs\\python$pyver.lib");
$plpython->AddReference($postgres); $plpython->AddReference($postgres);
...@@ -215,20 +225,24 @@ sub mkvcbuild ...@@ -215,20 +225,24 @@ sub mkvcbuild
if ($solution->{options}->{tcl}) if ($solution->{options}->{tcl})
{ {
my $pltcl = $solution->AddProject('pltcl','dll','PLs','src\pl\tcl'); my $pltcl =
$solution->AddProject('pltcl', 'dll', 'PLs', 'src\pl\tcl');
$pltcl->AddIncludeDir($solution->{options}->{tcl} . '\include'); $pltcl->AddIncludeDir($solution->{options}->{tcl} . '\include');
$pltcl->AddReference($postgres); $pltcl->AddReference($postgres);
if (-e $solution->{options}->{tcl} . '\lib\tcl85.lib') if (-e $solution->{options}->{tcl} . '\lib\tcl85.lib')
{ {
$pltcl->AddLibrary($solution->{options}->{tcl} . '\lib\tcl85.lib'); $pltcl->AddLibrary(
$solution->{options}->{tcl} . '\lib\tcl85.lib');
} }
else else
{ {
$pltcl->AddLibrary($solution->{options}->{tcl} . '\lib\tcl84.lib'); $pltcl->AddLibrary(
$solution->{options}->{tcl} . '\lib\tcl84.lib');
} }
} }
$libpq = $solution->AddProject('libpq','dll','interfaces','src\interfaces\libpq'); $libpq = $solution->AddProject('libpq', 'dll', 'interfaces',
'src\interfaces\libpq');
$libpq->AddDefine('FRONTEND'); $libpq->AddDefine('FRONTEND');
$libpq->AddDefine('UNSAFE_STAT_OK'); $libpq->AddDefine('UNSAFE_STAT_OK');
$libpq->AddIncludeDir('src\port'); $libpq->AddIncludeDir('src\port');
...@@ -237,50 +251,56 @@ sub mkvcbuild ...@@ -237,50 +251,56 @@ sub mkvcbuild
$libpq->AddLibrary('ws2_32.lib'); $libpq->AddLibrary('ws2_32.lib');
$libpq->AddLibrary('wldap32.lib') if ($solution->{options}->{ldap}); $libpq->AddLibrary('wldap32.lib') if ($solution->{options}->{ldap});
$libpq->UseDef('src\interfaces\libpq\libpqdll.def'); $libpq->UseDef('src\interfaces\libpq\libpqdll.def');
$libpq->ReplaceFile('src\interfaces\libpq\libpqrc.c','src\interfaces\libpq\libpq.rc'); $libpq->ReplaceFile('src\interfaces\libpq\libpqrc.c',
'src\interfaces\libpq\libpq.rc');
$libpq->AddReference($libpgport); $libpq->AddReference($libpgport);
my $libpqwalreceiver = $solution->AddProject('libpqwalreceiver', 'dll', '', my $libpqwalreceiver =
$solution->AddProject('libpqwalreceiver', 'dll', '',
'src\backend\replication\libpqwalreceiver'); 'src\backend\replication\libpqwalreceiver');
$libpqwalreceiver->AddIncludeDir('src\interfaces\libpq'); $libpqwalreceiver->AddIncludeDir('src\interfaces\libpq');
$libpqwalreceiver->AddReference($postgres,$libpq); $libpqwalreceiver->AddReference($postgres, $libpq);
my $pgtypes = my $pgtypes = $solution->AddProject(
$solution->AddProject('libpgtypes','dll','interfaces','src\interfaces\ecpg\pgtypeslib'); 'libpgtypes', 'dll',
'interfaces', 'src\interfaces\ecpg\pgtypeslib');
$pgtypes->AddDefine('FRONTEND'); $pgtypes->AddDefine('FRONTEND');
$pgtypes->AddReference($libpgport); $pgtypes->AddReference($libpgport);
$pgtypes->UseDef('src\interfaces\ecpg\pgtypeslib\pgtypeslib.def'); $pgtypes->UseDef('src\interfaces\ecpg\pgtypeslib\pgtypeslib.def');
$pgtypes->AddIncludeDir('src\interfaces\ecpg\include'); $pgtypes->AddIncludeDir('src\interfaces\ecpg\include');
my $libecpg = my $libecpg = $solution->AddProject('libecpg', 'dll', 'interfaces',
$solution->AddProject('libecpg','dll','interfaces','src\interfaces\ecpg\ecpglib'); 'src\interfaces\ecpg\ecpglib');
$libecpg->AddDefine('FRONTEND'); $libecpg->AddDefine('FRONTEND');
$libecpg->AddIncludeDir('src\interfaces\ecpg\include'); $libecpg->AddIncludeDir('src\interfaces\ecpg\include');
$libecpg->AddIncludeDir('src\interfaces\libpq'); $libecpg->AddIncludeDir('src\interfaces\libpq');
$libecpg->AddIncludeDir('src\port'); $libecpg->AddIncludeDir('src\port');
$libecpg->UseDef('src\interfaces\ecpg\ecpglib\ecpglib.def'); $libecpg->UseDef('src\interfaces\ecpg\ecpglib\ecpglib.def');
$libecpg->AddLibrary('wsock32.lib'); $libecpg->AddLibrary('wsock32.lib');
$libecpg->AddReference($libpq,$pgtypes,$libpgport); $libecpg->AddReference($libpq, $pgtypes, $libpgport);
my $libecpgcompat =$solution->AddProject('libecpg_compat','dll','interfaces', my $libecpgcompat = $solution->AddProject(
'src\interfaces\ecpg\compatlib'); 'libecpg_compat', 'dll',
'interfaces', 'src\interfaces\ecpg\compatlib');
$libecpgcompat->AddIncludeDir('src\interfaces\ecpg\include'); $libecpgcompat->AddIncludeDir('src\interfaces\ecpg\include');
$libecpgcompat->AddIncludeDir('src\interfaces\libpq'); $libecpgcompat->AddIncludeDir('src\interfaces\libpq');
$libecpgcompat->UseDef('src\interfaces\ecpg\compatlib\compatlib.def'); $libecpgcompat->UseDef('src\interfaces\ecpg\compatlib\compatlib.def');
$libecpgcompat->AddReference($pgtypes,$libecpg,$libpgport); $libecpgcompat->AddReference($pgtypes, $libecpg, $libpgport);
my $ecpg = $solution->AddProject('ecpg','exe','interfaces','src\interfaces\ecpg\preproc'); my $ecpg = $solution->AddProject('ecpg', 'exe', 'interfaces',
'src\interfaces\ecpg\preproc');
$ecpg->AddIncludeDir('src\interfaces\ecpg\include'); $ecpg->AddIncludeDir('src\interfaces\ecpg\include');
$ecpg->AddIncludeDir('src\interfaces\libpq'); $ecpg->AddIncludeDir('src\interfaces\libpq');
$ecpg->AddPrefixInclude('src\interfaces\ecpg\preproc'); $ecpg->AddPrefixInclude('src\interfaces\ecpg\preproc');
$ecpg->AddFiles('src\interfaces\ecpg\preproc','pgc.l','preproc.y'); $ecpg->AddFiles('src\interfaces\ecpg\preproc', 'pgc.l', 'preproc.y');
$ecpg->AddDefine('MAJOR_VERSION=4'); $ecpg->AddDefine('MAJOR_VERSION=4');
$ecpg->AddDefine('MINOR_VERSION=9'); $ecpg->AddDefine('MINOR_VERSION=9');
$ecpg->AddDefine('PATCHLEVEL=0'); $ecpg->AddDefine('PATCHLEVEL=0');
$ecpg->AddDefine('ECPG_COMPILE'); $ecpg->AddDefine('ECPG_COMPILE');
$ecpg->AddReference($libpgport); $ecpg->AddReference($libpgport);
my $pgregress_ecpg = $solution->AddProject('pg_regress_ecpg','exe','misc'); my $pgregress_ecpg =
$solution->AddProject('pg_regress_ecpg', 'exe', 'misc');
$pgregress_ecpg->AddFile('src\interfaces\ecpg\test\pg_regress_ecpg.c'); $pgregress_ecpg->AddFile('src\interfaces\ecpg\test\pg_regress_ecpg.c');
$pgregress_ecpg->AddFile('src\test\regress\pg_regress.c'); $pgregress_ecpg->AddFile('src\test\regress\pg_regress.c');
$pgregress_ecpg->AddIncludeDir('src\port'); $pgregress_ecpg->AddIncludeDir('src\port');
...@@ -289,7 +309,8 @@ sub mkvcbuild ...@@ -289,7 +309,8 @@ sub mkvcbuild
$pgregress_ecpg->AddDefine('FRONTEND'); $pgregress_ecpg->AddDefine('FRONTEND');
$pgregress_ecpg->AddReference($libpgport); $pgregress_ecpg->AddReference($libpgport);
my $isolation_tester = $solution->AddProject('isolationtester','exe','misc'); my $isolation_tester =
$solution->AddProject('isolationtester', 'exe', 'misc');
$isolation_tester->AddFile('src\test\isolation\isolationtester.c'); $isolation_tester->AddFile('src\test\isolation\isolationtester.c');
$isolation_tester->AddFile('src\test\isolation\specparse.y'); $isolation_tester->AddFile('src\test\isolation\specparse.y');
$isolation_tester->AddFile('src\test\isolation\specscanner.l'); $isolation_tester->AddFile('src\test\isolation\specscanner.l');
...@@ -303,7 +324,8 @@ sub mkvcbuild ...@@ -303,7 +324,8 @@ sub mkvcbuild
$isolation_tester->AddLibrary('wsock32.lib'); $isolation_tester->AddLibrary('wsock32.lib');
$isolation_tester->AddReference($libpq, $libpgport); $isolation_tester->AddReference($libpq, $libpgport);
my $pgregress_isolation = $solution->AddProject('pg_isolation_regress','exe','misc'); my $pgregress_isolation =
$solution->AddProject('pg_isolation_regress', 'exe', 'misc');
$pgregress_isolation->AddFile('src\test\isolation\isolation_main.c'); $pgregress_isolation->AddFile('src\test\isolation\isolation_main.c');
$pgregress_isolation->AddFile('src\test\regress\pg_regress.c'); $pgregress_isolation->AddFile('src\test\regress\pg_regress.c');
$pgregress_isolation->AddIncludeDir('src\port'); $pgregress_isolation->AddIncludeDir('src\port');
...@@ -337,9 +359,10 @@ sub mkvcbuild ...@@ -337,9 +359,10 @@ sub mkvcbuild
my $pgreset = AddSimpleFrontend('pg_resetxlog'); my $pgreset = AddSimpleFrontend('pg_resetxlog');
my $pgevent = $solution->AddProject('pgevent','dll','bin'); my $pgevent = $solution->AddProject('pgevent', 'dll', 'bin');
$pgevent->AddFiles('src\bin\pgevent','pgevent.c','pgmsgevent.rc'); $pgevent->AddFiles('src\bin\pgevent', 'pgevent.c', 'pgmsgevent.rc');
$pgevent->AddResourceFile('src\bin\pgevent','Eventlog message formatter'); $pgevent->AddResourceFile('src\bin\pgevent',
'Eventlog message formatter');
$pgevent->RemoveFile('src\bin\pgevent\win32ver.rc'); $pgevent->RemoveFile('src\bin\pgevent\win32ver.rc');
$pgevent->UseDef('src\bin\pgevent\pgevent.def'); $pgevent->UseDef('src\bin\pgevent\pgevent.def');
$pgevent->DisableLinkerWarnings('4104'); $pgevent->DisableLinkerWarnings('4104');
...@@ -363,9 +386,9 @@ sub mkvcbuild ...@@ -363,9 +386,9 @@ sub mkvcbuild
# pg_dump and pg_restore. # pg_dump and pg_restore.
# So remove their sources from the object, keeping the other setup that # So remove their sources from the object, keeping the other setup that
# AddSimpleFrontend() has done. # AddSimpleFrontend() has done.
my @nodumpall = grep { m/src\\bin\\pg_dump\\.*\.c$/ } my @nodumpall = grep { m/src\\bin\\pg_dump\\.*\.c$/ }
keys %{$pgdumpall->{files}}; keys %{ $pgdumpall->{files} };
delete @{$pgdumpall->{files}}{@nodumpall}; delete @{ $pgdumpall->{files} }{@nodumpall};
$pgdumpall->{name} = 'pg_dumpall'; $pgdumpall->{name} = 'pg_dumpall';
$pgdumpall->AddIncludeDir('src\backend'); $pgdumpall->AddIncludeDir('src\backend');
$pgdumpall->AddFile('src\bin\pg_dump\pg_dumpall.c'); $pgdumpall->AddFile('src\bin\pg_dump\pg_dumpall.c');
...@@ -381,8 +404,9 @@ sub mkvcbuild ...@@ -381,8 +404,9 @@ sub mkvcbuild
$pgrestore->AddFile('src\bin\pg_dump\keywords.c'); $pgrestore->AddFile('src\bin\pg_dump\keywords.c');
$pgrestore->AddFile('src\backend\parser\kwlookup.c'); $pgrestore->AddFile('src\backend\parser\kwlookup.c');
my $zic = $solution->AddProject('zic','exe','utils'); my $zic = $solution->AddProject('zic', 'exe', 'utils');
$zic->AddFiles('src\timezone','zic.c','ialloc.c','scheck.c','localtime.c'); $zic->AddFiles('src\timezone', 'zic.c', 'ialloc.c', 'scheck.c',
'localtime.c');
$zic->AddReference($libpgport); $zic->AddReference($libpgport);
if ($solution->{options}->{xml}) if ($solution->{options}->{xml})
...@@ -390,22 +414,20 @@ sub mkvcbuild ...@@ -390,22 +414,20 @@ sub mkvcbuild
$contrib_extraincludes->{'pgxml'} = [ $contrib_extraincludes->{'pgxml'} = [
$solution->{options}->{xml} . '\include', $solution->{options}->{xml} . '\include',
$solution->{options}->{xslt} . '\include', $solution->{options}->{xslt} . '\include',
$solution->{options}->{iconv} . '\include' $solution->{options}->{iconv} . '\include' ];
];
$contrib_extralibs->{'pgxml'} = [ $contrib_extralibs->{'pgxml'} = [
$solution->{options}->{xml} . '\lib\libxml2.lib', $solution->{options}->{xml} . '\lib\libxml2.lib',
$solution->{options}->{xslt} . '\lib\libxslt.lib' $solution->{options}->{xslt} . '\lib\libxslt.lib' ];
];
} }
else else
{ {
push @contrib_excludes,'xml2'; push @contrib_excludes, 'xml2';
} }
if (!$solution->{options}->{openssl}) if (!$solution->{options}->{openssl})
{ {
push @contrib_excludes,'sslinfo'; push @contrib_excludes, 'sslinfo';
} }
if ($solution->{options}->{uuid}) if ($solution->{options}->{uuid})
...@@ -417,33 +439,38 @@ sub mkvcbuild ...@@ -417,33 +439,38 @@ sub mkvcbuild
} }
else else
{ {
push @contrib_excludes,'uuid-ossp'; push @contrib_excludes, 'uuid-ossp';
} }
# Pgcrypto makefile too complex to parse.... # Pgcrypto makefile too complex to parse....
my $pgcrypto = $solution->AddProject('pgcrypto','dll','crypto'); my $pgcrypto = $solution->AddProject('pgcrypto', 'dll', 'crypto');
$pgcrypto->AddFiles( $pgcrypto->AddFiles(
'contrib\pgcrypto','pgcrypto.c','px.c','px-hmac.c', 'contrib\pgcrypto', 'pgcrypto.c',
'px-crypt.c','crypt-gensalt.c','crypt-blowfish.c','crypt-des.c', 'px.c', 'px-hmac.c',
'crypt-md5.c','mbuf.c','pgp.c','pgp-armor.c', 'px-crypt.c', 'crypt-gensalt.c',
'pgp-cfb.c','pgp-compress.c','pgp-decrypt.c','pgp-encrypt.c', 'crypt-blowfish.c', 'crypt-des.c',
'pgp-info.c','pgp-mpi.c','pgp-pubdec.c','pgp-pubenc.c', 'crypt-md5.c', 'mbuf.c',
'pgp-pubkey.c','pgp-s2k.c','pgp-pgsql.c' 'pgp.c', 'pgp-armor.c',
); 'pgp-cfb.c', 'pgp-compress.c',
'pgp-decrypt.c', 'pgp-encrypt.c',
'pgp-info.c', 'pgp-mpi.c',
'pgp-pubdec.c', 'pgp-pubenc.c',
'pgp-pubkey.c', 'pgp-s2k.c',
'pgp-pgsql.c');
if ($solution->{options}->{openssl}) if ($solution->{options}->{openssl})
{ {
$pgcrypto->AddFiles('contrib\pgcrypto', 'openssl.c','pgp-mpi-openssl.c'); $pgcrypto->AddFiles('contrib\pgcrypto', 'openssl.c',
'pgp-mpi-openssl.c');
} }
else else
{ {
$pgcrypto->AddFiles( $pgcrypto->AddFiles(
'contrib\pgcrypto', 'md5.c', 'contrib\pgcrypto', 'md5.c',
'sha1.c','sha2.c', 'sha1.c', 'sha2.c',
'internal.c','internal-sha2.c', 'internal.c', 'internal-sha2.c',
'blf.c','rijndael.c', 'blf.c', 'rijndael.c',
'fortuna.c','random.c', 'fortuna.c', 'random.c',
'pgp-mpi-internal.c','imath.c' 'pgp-mpi-internal.c', 'imath.c');
);
} }
$pgcrypto->AddReference($postgres); $pgcrypto->AddReference($postgres);
$pgcrypto->AddLibrary('wsock32.lib'); $pgcrypto->AddLibrary('wsock32.lib');
...@@ -456,35 +483,43 @@ sub mkvcbuild ...@@ -456,35 +483,43 @@ sub mkvcbuild
{ {
next if ($d =~ /^\./); next if ($d =~ /^\./);
next unless (-f "contrib/$d/Makefile"); next unless (-f "contrib/$d/Makefile");
next if (grep {/^$d$/} @contrib_excludes); next if (grep { /^$d$/ } @contrib_excludes);
AddContrib($d); AddContrib($d);
} }
closedir($D); closedir($D);
$mf = Project::read_file('src\backend\utils\mb\conversion_procs\Makefile'); $mf =
Project::read_file('src\backend\utils\mb\conversion_procs\Makefile');
$mf =~ s{\\s*[\r\n]+}{}mg; $mf =~ s{\\s*[\r\n]+}{}mg;
$mf =~ m{SUBDIRS\s*=\s*(.*)$}m || die 'Could not match in conversion makefile' . "\n"; $mf =~ m{SUBDIRS\s*=\s*(.*)$}m
foreach my $sub (split /\s+/,$1) || die 'Could not match in conversion makefile' . "\n";
foreach my $sub (split /\s+/, $1)
{ {
my $mf = Project::read_file( my $mf = Project::read_file(
'src\backend\utils\mb\conversion_procs\\' . $sub . '\Makefile'); 'src\backend\utils\mb\conversion_procs\\' . $sub . '\Makefile');
my $p = $solution->AddProject($sub, 'dll', 'conversion procs'); my $p = $solution->AddProject($sub, 'dll', 'conversion procs');
$p->AddFile('src\backend\utils\mb\conversion_procs\\' . $sub . '\\' . $sub . '.c'); $p->AddFile('src\backend\utils\mb\conversion_procs\\'
. $sub . '\\'
. $sub
. '.c');
if ($mf =~ m{^SRCS\s*\+=\s*(.*)$}m) if ($mf =~ m{^SRCS\s*\+=\s*(.*)$}m)
{ {
$p->AddFile('src\backend\utils\mb\conversion_procs\\' . $sub . '\\' . $1); $p->AddFile(
'src\backend\utils\mb\conversion_procs\\' . $sub . '\\' . $1);
} }
$p->AddReference($postgres); $p->AddReference($postgres);
} }
$mf = Project::read_file('src\bin\scripts\Makefile'); $mf = Project::read_file('src\bin\scripts\Makefile');
$mf =~ s{\\s*[\r\n]+}{}mg; $mf =~ s{\\s*[\r\n]+}{}mg;
$mf =~ m{PROGRAMS\s*=\s*(.*)$}m || die 'Could not match in bin\scripts\Makefile' . "\n"; $mf =~ m{PROGRAMS\s*=\s*(.*)$}m
foreach my $prg (split /\s+/,$1) || die 'Could not match in bin\scripts\Makefile' . "\n";
foreach my $prg (split /\s+/, $1)
{ {
my $proj = $solution->AddProject($prg,'exe','bin'); my $proj = $solution->AddProject($prg, 'exe', 'bin');
$mf =~ m{$prg\s*:\s*(.*)$}m || die 'Could not find script define for $prg' . "\n"; $mf =~ m{$prg\s*:\s*(.*)$}m
my @files = split /\s+/,$1; || die 'Could not find script define for $prg' . "\n";
my @files = split /\s+/, $1;
foreach my $f (@files) foreach my $f (@files)
{ {
$f =~ s/\.o$/\.c/; $f =~ s/\.o$/\.c/;
...@@ -501,7 +536,7 @@ sub mkvcbuild ...@@ -501,7 +536,7 @@ sub mkvcbuild
$proj->AddFile('src\bin\pg_dump\dumputils.c'); $proj->AddFile('src\bin\pg_dump\dumputils.c');
} }
elsif ($f =~ /print\.c$/) elsif ($f =~ /print\.c$/)
{ # Also catches mbprint.c { # Also catches mbprint.c
$proj->AddFile('src\bin\psql\\' . $f); $proj->AddFile('src\bin\psql\\' . $f);
} }
elsif ($f =~ /\.c$/) elsif ($f =~ /\.c$/)
...@@ -512,16 +547,16 @@ sub mkvcbuild ...@@ -512,16 +547,16 @@ sub mkvcbuild
$proj->AddIncludeDir('src\interfaces\libpq'); $proj->AddIncludeDir('src\interfaces\libpq');
$proj->AddIncludeDir('src\bin\pg_dump'); $proj->AddIncludeDir('src\bin\pg_dump');
$proj->AddIncludeDir('src\bin\psql'); $proj->AddIncludeDir('src\bin\psql');
$proj->AddReference($libpq,$libpgport); $proj->AddReference($libpq, $libpgport);
$proj->AddResourceFile('src\bin\scripts','PostgreSQL Utility'); $proj->AddResourceFile('src\bin\scripts', 'PostgreSQL Utility');
} }
# Regression DLL and EXE # Regression DLL and EXE
my $regress = $solution->AddProject('regress','dll','misc'); my $regress = $solution->AddProject('regress', 'dll', 'misc');
$regress->AddFile('src\test\regress\regress.c'); $regress->AddFile('src\test\regress\regress.c');
$regress->AddReference($postgres); $regress->AddReference($postgres);
my $pgregress = $solution->AddProject('pg_regress','exe','misc'); my $pgregress = $solution->AddProject('pg_regress', 'exe', 'misc');
$pgregress->AddFile('src\test\regress\pg_regress.c'); $pgregress->AddFile('src\test\regress\pg_regress.c');
$pgregress->AddFile('src\test\regress\pg_regress_main.c'); $pgregress->AddFile('src\test\regress\pg_regress_main.c');
$pgregress->AddIncludeDir('src\port'); $pgregress->AddIncludeDir('src\port');
...@@ -539,10 +574,10 @@ sub mkvcbuild ...@@ -539,10 +574,10 @@ sub mkvcbuild
# Add a simple frontend project (exe) # Add a simple frontend project (exe)
sub AddSimpleFrontend sub AddSimpleFrontend
{ {
my $n = shift; my $n = shift;
my $uselibpq= shift; my $uselibpq = shift;
my $p = $solution->AddProject($n,'exe','bin'); my $p = $solution->AddProject($n, 'exe', 'bin');
$p->AddDir('src\bin\\' . $n); $p->AddDir('src\bin\\' . $n);
$p->AddReference($libpgport); $p->AddReference($libpgport);
if ($uselibpq) if ($uselibpq)
...@@ -556,7 +591,7 @@ sub AddSimpleFrontend ...@@ -556,7 +591,7 @@ sub AddSimpleFrontend
# Add a simple contrib project # Add a simple contrib project
sub AddContrib sub AddContrib
{ {
my $n = shift; my $n = shift;
my $mf = Project::read_file('contrib\\' . $n . '\Makefile'); my $mf = Project::read_file('contrib\\' . $n . '\Makefile');
if ($mf =~ /^MODULE_big\s*=\s*(.*)$/mg) if ($mf =~ /^MODULE_big\s*=\s*(.*)$/mg)
...@@ -578,8 +613,8 @@ sub AddContrib ...@@ -578,8 +613,8 @@ sub AddContrib
{ {
foreach my $d (split /\s+/, $1) foreach my $d (split /\s+/, $1)
{ {
my $mf2 = my $mf2 = Project::read_file(
Project::read_file('contrib\\' . $n . '\\' . $d . '\Makefile'); 'contrib\\' . $n . '\\' . $d . '\Makefile');
$mf2 =~ s{\\\s*[\r\n]+}{}mg; $mf2 =~ s{\\\s*[\r\n]+}{}mg;
$mf2 =~ /^SUBOBJS\s*=\s*(.*)$/gm $mf2 =~ /^SUBOBJS\s*=\s*(.*)$/gm
|| croak || croak
...@@ -609,7 +644,8 @@ sub AddContrib ...@@ -609,7 +644,8 @@ sub AddContrib
{ {
my $proj = $solution->AddProject($1, 'exe', 'contrib'); my $proj = $solution->AddProject($1, 'exe', 'contrib');
$mf =~ s{\\\s*[\r\n]+}{}mg; $mf =~ s{\\\s*[\r\n]+}{}mg;
$mf =~ /^OBJS\s*=\s*(.*)$/gm || croak "Could not find objects in PROGRAM for $n\n"; $mf =~ /^OBJS\s*=\s*(.*)$/gm
|| croak "Could not find objects in PROGRAM for $n\n";
my $objs = $1; my $objs = $1;
while ($objs =~ /\b([\w-]+\.o)\b/g) while ($objs =~ /\b([\w-]+\.o)\b/g)
{ {
...@@ -630,7 +666,7 @@ sub AddContrib ...@@ -630,7 +666,7 @@ sub AddContrib
sub GenerateContribSqlFiles sub GenerateContribSqlFiles
{ {
my $n = shift; my $n = shift;
my $mf = shift; my $mf = shift;
if ($mf =~ /^DATA_built\s*=\s*(.*)$/mg) if ($mf =~ /^DATA_built\s*=\s*(.*)$/mg)
{ {
...@@ -645,25 +681,26 @@ sub GenerateContribSqlFiles ...@@ -645,25 +681,26 @@ sub GenerateContribSqlFiles
{ {
$pcount++ if (substr($l, $i, 1) eq '('); $pcount++ if (substr($l, $i, 1) eq '(');
$pcount-- if (substr($l, $i, 1) eq ')'); $pcount-- if (substr($l, $i, 1) eq ')');
last if ($pcount < 0); last if ($pcount < 0);
} }
$l = substr($l, 0, index($l, '$(addsuffix ')) . substr($l, $i+1); $l =
substr($l, 0, index($l, '$(addsuffix ')) . substr($l, $i + 1);
} }
foreach my $d (split /\s+/, $l) foreach my $d (split /\s+/, $l)
{ {
my $in = "$d.in"; my $in = "$d.in";
my $out = "$d"; my $out = "$d";
if (Solution::IsNewer("contrib/$n/$out", "contrib/$n/$in")) if (Solution::IsNewer("contrib/$n/$out", "contrib/$n/$in"))
{ {
print "Building $out from $in (contrib/$n)...\n"; print "Building $out from $in (contrib/$n)...\n";
my $cont = Project::read_file("contrib/$n/$in"); my $cont = Project::read_file("contrib/$n/$in");
my $dn = $out; my $dn = $out;
$dn =~ s/\.sql$//; $dn =~ s/\.sql$//;
$cont =~ s/MODULE_PATHNAME/\$libdir\/$dn/g; $cont =~ s/MODULE_PATHNAME/\$libdir\/$dn/g;
my $o; my $o;
open($o,">contrib/$n/$out") open($o, ">contrib/$n/$out")
|| croak "Could not write to contrib/$n/$d"; || croak "Could not write to contrib/$n/$d";
print $o $cont; print $o $cont;
close($o); close($o);
...@@ -675,7 +712,7 @@ sub GenerateContribSqlFiles ...@@ -675,7 +712,7 @@ sub GenerateContribSqlFiles
sub AdjustContribProj sub AdjustContribProj
{ {
my $proj = shift; my $proj = shift;
my $n = $proj->{name}; my $n = $proj->{name};
if ($contrib_defines->{$n}) if ($contrib_defines->{$n})
{ {
...@@ -684,32 +721,32 @@ sub AdjustContribProj ...@@ -684,32 +721,32 @@ sub AdjustContribProj
$proj->AddDefine($d); $proj->AddDefine($d);
} }
} }
if (grep {/^$n$/} @contrib_uselibpq) if (grep { /^$n$/ } @contrib_uselibpq)
{ {
$proj->AddIncludeDir('src\interfaces\libpq'); $proj->AddIncludeDir('src\interfaces\libpq');
$proj->AddReference($libpq); $proj->AddReference($libpq);
} }
if (grep {/^$n$/} @contrib_uselibpgport) if (grep { /^$n$/ } @contrib_uselibpgport)
{ {
$proj->AddReference($libpgport); $proj->AddReference($libpgport);
} }
if ($contrib_extralibs->{$n}) if ($contrib_extralibs->{$n})
{ {
foreach my $l (@{$contrib_extralibs->{$n}}) foreach my $l (@{ $contrib_extralibs->{$n} })
{ {
$proj->AddLibrary($l); $proj->AddLibrary($l);
} }
} }
if ($contrib_extraincludes->{$n}) if ($contrib_extraincludes->{$n})
{ {
foreach my $i (@{$contrib_extraincludes->{$n}}) foreach my $i (@{ $contrib_extraincludes->{$n} })
{ {
$proj->AddIncludeDir($i); $proj->AddIncludeDir($i);
} }
} }
if ($contrib_extrasource->{$n}) if ($contrib_extrasource->{$n})
{ {
$proj->AddFiles('contrib\\' . $n, @{$contrib_extrasource->{$n}}); $proj->AddFiles('contrib\\' . $n, @{ $contrib_extrasource->{$n} });
} }
} }
......
src/tools/msvc/Project.pm
View file @ 042d9ffc
...@@ -16,8 +16,7 @@ sub _new ...@@ -16,8 +16,7 @@ sub _new
my $good_types = { my $good_types = {
lib => 1, lib => 1,
exe => 1, exe => 1,
dll => 1, dll => 1, };
};
confess("Bad project type: $type\n") unless exists $good_types->{$type}; confess("Bad project type: $type\n") unless exists $good_types->{$type};
my $self = { my $self = {
name => $name, name => $name,
...@@ -33,8 +32,7 @@ sub _new ...@@ -33,8 +32,7 @@ sub _new
solution => $solution, solution => $solution,
disablewarnings => '4018;4244;4273;4102;4090;4267', disablewarnings => '4018;4244;4273;4102;4090;4267',
disablelinkerwarnings => '', disablelinkerwarnings => '',
platform => $solution->{platform}, platform => $solution->{platform}, };
};
bless($self, $classname); bless($self, $classname);
return $self; return $self;
...@@ -50,11 +48,11 @@ sub AddFile ...@@ -50,11 +48,11 @@ sub AddFile
sub AddFiles sub AddFiles
{ {
my $self = shift; my $self = shift;
my $dir = shift; my $dir = shift;
while (my $f = shift) while (my $f = shift)
{ {
$self->{files}->{$dir . "\\" . $f} = 1; $self->{files}->{ $dir . "\\" . $f } = 1;
} }
} }
...@@ -63,7 +61,7 @@ sub ReplaceFile ...@@ -63,7 +61,7 @@ sub ReplaceFile
my ($self, $filename, $newname) = @_; my ($self, $filename, $newname) = @_;
my $re = "\\\\$filename\$"; my $re = "\\\\$filename\$";
foreach my $file (keys %{$self->{files}}) foreach my $file (keys %{ $self->{files} })
{ {
# Match complete filename # Match complete filename
...@@ -89,9 +87,9 @@ sub ReplaceFile ...@@ -89,9 +87,9 @@ sub ReplaceFile
sub RemoveFile sub RemoveFile
{ {
my ($self, $filename) = @_; my ($self, $filename) = @_;
my $orig = scalar keys %{$self->{files}}; my $orig = scalar keys %{ $self->{files} };
delete $self->{files}->{$filename}; delete $self->{files}->{$filename};
if ($orig > scalar keys %{$self->{files}}) if ($orig > scalar keys %{ $self->{files} })
{ {
return; return;
} }
...@@ -101,7 +99,7 @@ sub RemoveFile ...@@ -101,7 +99,7 @@ sub RemoveFile
sub RelocateFiles sub RelocateFiles
{ {
my ($self, $targetdir, $proc) = @_; my ($self, $targetdir, $proc) = @_;
foreach my $f (keys %{$self->{files}}) foreach my $f (keys %{ $self->{files} })
{ {
my $r = &$proc($f); my $r = &$proc($f);
if ($r) if ($r)
...@@ -118,8 +116,9 @@ sub AddReference ...@@ -118,8 +116,9 @@ sub AddReference
while (my $ref = shift) while (my $ref = shift)
{ {
push @{$self->{references}},$ref; push @{ $self->{references} }, $ref;
$self->AddLibrary("__CFGNAME__\\" . $ref->{name} . "\\" . $ref->{name} . ".lib"); $self->AddLibrary(
"__CFGNAME__\\" . $ref->{name} . "\\" . $ref->{name} . ".lib");
} }
} }
...@@ -132,10 +131,10 @@ sub AddLibrary ...@@ -132,10 +131,10 @@ sub AddLibrary
$lib = '&quot;' . $lib . "&quot;"; $lib = '&quot;' . $lib . "&quot;";
} }
push @{$self->{libraries}}, $lib; push @{ $self->{libraries} }, $lib;
if ($dbgsuffix) if ($dbgsuffix)
{ {
push @{$self->{suffixlib}}, $lib; push @{ $self->{suffixlib} }, $lib;
} }
} }
...@@ -170,8 +169,8 @@ sub FullExportDLL ...@@ -170,8 +169,8 @@ sub FullExportDLL
my ($self, $libname) = @_; my ($self, $libname) = @_;
$self->{builddef} = 1; $self->{builddef} = 1;
$self->{def} = ".\\__CFGNAME__\\$self->{name}\\$self->{name}.def"; $self->{def} = ".\\__CFGNAME__\\$self->{name}\\$self->{name}.def";
$self->{implib} = "__CFGNAME__\\$self->{name}\\$libname"; $self->{implib} = "__CFGNAME__\\$self->{name}\\$libname";
} }
sub UseDef sub UseDef
...@@ -188,8 +187,8 @@ sub AddDir ...@@ -188,8 +187,8 @@ sub AddDir
my $t = $/; my $t = $/;
undef $/; undef $/;
open($MF,"$reldir\\Makefile") open($MF, "$reldir\\Makefile")
|| open($MF,"$reldir\\GNUMakefile") || open($MF, "$reldir\\GNUMakefile")
|| croak "Could not open $reldir\\Makefile\n"; || croak "Could not open $reldir\\Makefile\n";
my $mf = <$MF>; my $mf = <$MF>;
close($MF); close($MF);
...@@ -197,11 +196,11 @@ sub AddDir ...@@ -197,11 +196,11 @@ sub AddDir
$mf =~ s{\\\s*[\r\n]+}{}mg; $mf =~ s{\\\s*[\r\n]+}{}mg;
if ($mf =~ m{^(?:SUB)?DIRS[^=]*=\s*(.*)$}mg) if ($mf =~ m{^(?:SUB)?DIRS[^=]*=\s*(.*)$}mg)
{ {
foreach my $subdir (split /\s+/,$1) foreach my $subdir (split /\s+/, $1)
{ {
next next
if $subdir eq "\$(top_builddir)/src/timezone" if $subdir eq "\$(top_builddir)/src/timezone"
; #special case for non-standard include ; #special case for non-standard include
next next
if $reldir . "\\" . $subdir eq "src\\backend\\port\\darwin"; if $reldir . "\\" . $subdir eq "src\\backend\\port\\darwin";
...@@ -210,13 +209,13 @@ sub AddDir ...@@ -210,13 +209,13 @@ sub AddDir
} }
while ($mf =~ m{^(?:EXTRA_)?OBJS[^=]*=\s*(.*)$}m) while ($mf =~ m{^(?:EXTRA_)?OBJS[^=]*=\s*(.*)$}m)
{ {
my $s = $1; my $s = $1;
my $filter_re = qr{\$\(filter ([^,]+),\s+\$\(([^\)]+)\)\)}; my $filter_re = qr{\$\(filter ([^,]+),\s+\$\(([^\)]+)\)\)};
while ($s =~ /$filter_re/) while ($s =~ /$filter_re/)
{ {
# Process $(filter a b c, $(VAR)) expressions # Process $(filter a b c, $(VAR)) expressions
my $list = $1; my $list = $1;
my $filter = $2; my $filter = $2;
$list =~ s/\.o/\.c/g; $list =~ s/\.o/\.c/g;
my @pieces = split /\s+/, $list; my @pieces = split /\s+/, $list;
...@@ -239,12 +238,13 @@ sub AddDir ...@@ -239,12 +238,13 @@ sub AddDir
} }
$s =~ s/$filter_re/$matches/; $s =~ s/$filter_re/$matches/;
} }
foreach my $f (split /\s+/,$s) foreach my $f (split /\s+/, $s)
{ {
next if $f =~ /^\s*$/; next if $f =~ /^\s*$/;
next if $f eq "\\"; next if $f eq "\\";
next if $f =~ /\/SUBSYS.o$/; next if $f =~ /\/SUBSYS.o$/;
$f =~ s/,$//; # Remove trailing comma that can show up from filter stuff $f =~ s/,$//
; # Remove trailing comma that can show up from filter stuff
next unless $f =~ /.*\.o$/; next unless $f =~ /.*\.o$/;
$f =~ s/\.o$/\.c/; $f =~ s/\.o$/\.c/;
if ($f =~ /^\$\(top_builddir\)\/(.*)/) if ($f =~ /^\$\(top_builddir\)\/(.*)/)
...@@ -264,14 +264,15 @@ sub AddDir ...@@ -264,14 +264,15 @@ sub AddDir
# Match rules that pull in source files from different directories, eg # Match rules that pull in source files from different directories, eg
# pgstrcasecmp.c rint.c snprintf.c: % : $(top_srcdir)/src/port/% # pgstrcasecmp.c rint.c snprintf.c: % : $(top_srcdir)/src/port/%
my $replace_re = qr{^([^:\n\$]+\.c)\s*:\s*(?:%\s*: )?\$(\([^\)]+\))\/(.*)\/[^\/]+$}m; my $replace_re =
qr{^([^:\n\$]+\.c)\s*:\s*(?:%\s*: )?\$(\([^\)]+\))\/(.*)\/[^\/]+$}m;
while ($mf =~ m{$replace_re}m) while ($mf =~ m{$replace_re}m)
{ {
my $match = $1; my $match = $1;
my $top = $2; my $top = $2;
my $target = $3; my $target = $3;
$target =~ s{/}{\\}g; $target =~ s{/}{\\}g;
my @pieces = split /\s+/,$match; my @pieces = split /\s+/, $match;
foreach my $fn (@pieces) foreach my $fn (@pieces)
{ {
if ($top eq "(top_srcdir)") if ($top eq "(top_srcdir)")
...@@ -296,7 +297,7 @@ sub AddDir ...@@ -296,7 +297,7 @@ sub AddDir
my $desc = $1; my $desc = $1;
my $ico; my $ico;
if ($mf =~ /^PGAPPICON\s*=\s*(.*)$/m) { $ico = $1; } if ($mf =~ /^PGAPPICON\s*=\s*(.*)$/m) { $ico = $1; }
$self->AddResourceFile($reldir,$desc,$ico); $self->AddResourceFile($reldir, $desc, $ico);
} }
$/ = $t; $/ = $t;
} }
...@@ -305,15 +306,18 @@ sub AddResourceFile ...@@ -305,15 +306,18 @@ sub AddResourceFile
{ {
my ($self, $dir, $desc, $ico) = @_; my ($self, $dir, $desc, $ico) = @_;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
localtime(time);
my $d = ($year - 100) . "$yday"; my $d = ($year - 100) . "$yday";
if (Solution::IsNewer("$dir\\win32ver.rc",'src\port\win32ver.rc')) if (Solution::IsNewer("$dir\\win32ver.rc", 'src\port\win32ver.rc'))
{ {
print "Generating win32ver.rc for $dir\n"; print "Generating win32ver.rc for $dir\n";
open(I,'src\port\win32ver.rc') || confess "Could not open win32ver.rc"; open(I, 'src\port\win32ver.rc')
open(O,">$dir\\win32ver.rc") || confess "Could not write win32ver.rc"; || confess "Could not open win32ver.rc";
my $icostr = $ico?"IDI_ICON ICON \"src/port/$ico.ico\"":""; open(O, ">$dir\\win32ver.rc")
|| confess "Could not write win32ver.rc";
my $icostr = $ico ? "IDI_ICON ICON \"src/port/$ico.ico\"" : "";
while (<I>) while (<I>)
{ {
s/FILEDESC/"$desc"/gm; s/FILEDESC/"$desc"/gm;
...@@ -335,7 +339,8 @@ sub DisableLinkerWarnings ...@@ -335,7 +339,8 @@ sub DisableLinkerWarnings
{ {
my ($self, $warnings) = @_; my ($self, $warnings) = @_;
$self->{disablelinkerwarnings} .= ',' unless ($self->{disablelinkerwarnings} eq ''); $self->{disablelinkerwarnings} .= ','
unless ($self->{disablelinkerwarnings} eq '');
$self->{disablelinkerwarnings} .= $warnings; $self->{disablelinkerwarnings} .= $warnings;
} }
...@@ -343,20 +348,21 @@ sub Save ...@@ -343,20 +348,21 @@ sub Save
{ {
my ($self) = @_; my ($self) = @_;
# If doing DLL and haven't specified a DEF file, do a full export of all symbols # If doing DLL and haven't specified a DEF file, do a full export of all symbols
# in the project. # in the project.
if ($self->{type} eq "dll" && !$self->{def}) if ($self->{type} eq "dll" && !$self->{def})
{ {
$self->FullExportDLL($self->{name} . ".lib"); $self->FullExportDLL($self->{name} . ".lib");
} }
# Warning 4197 is about double exporting, disable this per # Warning 4197 is about double exporting, disable this per
# http://connect.microsoft.com/VisualStudio/feedback/ViewFeedback.aspx?FeedbackID=99193 # http://connect.microsoft.com/VisualStudio/feedback/ViewFeedback.aspx?FeedbackID=99193
$self->DisableLinkerWarnings('4197') if ($self->{platform} eq 'x64'); $self->DisableLinkerWarnings('4197') if ($self->{platform} eq 'x64');
# Dump the project # Dump the project
open(F, ">$self->{name}$self->{filenameExtension}") open(F, ">$self->{name}$self->{filenameExtension}")
|| croak("Could not write to $self->{name}$self->{filenameExtension}\n"); || croak(
"Could not write to $self->{name}$self->{filenameExtension}\n");
$self->WriteHeader(*F); $self->WriteHeader(*F);
$self->WriteFiles(*F); $self->WriteFiles(*F);
$self->Footer(*F); $self->Footer(*F);
...@@ -366,12 +372,12 @@ sub Save ...@@ -366,12 +372,12 @@ sub Save
sub GetAdditionalLinkerDependencies sub GetAdditionalLinkerDependencies
{ {
my ($self, $cfgname, $seperator) = @_; my ($self, $cfgname, $seperator) = @_;
my $libcfg = (uc $cfgname eq "RELEASE")?"MD":"MDd"; my $libcfg = (uc $cfgname eq "RELEASE") ? "MD" : "MDd";
my $libs = ''; my $libs = '';
foreach my $lib (@{$self->{libraries}}) foreach my $lib (@{ $self->{libraries} })
{ {
my $xlib = $lib; my $xlib = $lib;
foreach my $slib (@{$self->{suffixlib}}) foreach my $slib (@{ $self->{suffixlib} })
{ {
if ($slib eq $lib) if ($slib eq $lib)
{ {
......
src/tools/msvc/Solution.pm
View file @ 042d9ffc
...@@ -13,15 +13,14 @@ use VSObjectFactory; ...@@ -13,15 +13,14 @@ use VSObjectFactory;
sub _new sub _new
{ {
my $classname = shift; my $classname = shift;
my $options = shift; my $options = shift;
my $self = { my $self = {
projects => {}, projects => {},
options => $options, options => $options,
numver => '', numver => '',
strver => '', strver => '',
vcver => undef, vcver => undef,
platform => undef, platform => undef, };
};
bless($self, $classname); bless($self, $classname);
# integer_datetimes is now the default # integer_datetimes is now the default
...@@ -37,22 +36,23 @@ sub _new ...@@ -37,22 +36,23 @@ sub _new
} }
} }
$options->{blocksize} = 8 $options->{blocksize} = 8
unless $options->{blocksize}; # undef or 0 means default unless $options->{blocksize}; # undef or 0 means default
die "Bad blocksize $options->{blocksize}" die "Bad blocksize $options->{blocksize}"
unless grep {$_ == $options->{blocksize}} (1,2,4,8,16,32); unless grep { $_ == $options->{blocksize} } (1, 2, 4, 8, 16, 32);
$options->{segsize} = 1 $options->{segsize} = 1
unless $options->{segsize}; # undef or 0 means default unless $options->{segsize}; # undef or 0 means default
# only allow segsize 1 for now, as we can't do large files yet in windows # only allow segsize 1 for now, as we can't do large files yet in windows
die "Bad segsize $options->{segsize}" die "Bad segsize $options->{segsize}"
unless $options->{segsize} == 1; unless $options->{segsize} == 1;
$options->{wal_blocksize} = 8 $options->{wal_blocksize} = 8
unless $options->{wal_blocksize}; # undef or 0 means default unless $options->{wal_blocksize}; # undef or 0 means default
die "Bad wal_blocksize $options->{wal_blocksize}" die "Bad wal_blocksize $options->{wal_blocksize}"
unless grep {$_ == $options->{wal_blocksize}} (1,2,4,8,16,32,64); unless grep { $_ == $options->{wal_blocksize} }
(1, 2, 4, 8, 16, 32, 64);
$options->{wal_segsize} = 16 $options->{wal_segsize} = 16
unless $options->{wal_segsize}; # undef or 0 means default unless $options->{wal_segsize}; # undef or 0 means default
die "Bad wal_segsize $options->{wal_segsize}" die "Bad wal_segsize $options->{wal_segsize}"
unless grep {$_ == $options->{wal_segsize}} (1,2,4,8,16,32,64); unless grep { $_ == $options->{wal_segsize} } (1, 2, 4, 8, 16, 32, 64);
$self->DeterminePlatform(); $self->DeterminePlatform();
...@@ -66,7 +66,7 @@ sub DeterminePlatform ...@@ -66,7 +66,7 @@ sub DeterminePlatform
# Determine if we are in 32 or 64-bit mode. Do this by seeing if CL has # Determine if we are in 32 or 64-bit mode. Do this by seeing if CL has
# 64-bit only parameters. # 64-bit only parameters.
$self->{platform} = 'Win32'; $self->{platform} = 'Win32';
open(P,"cl /? 2>NUL|") || die "cl command not found"; open(P, "cl /? 2>NUL|") || die "cl command not found";
while (<P>) while (<P>)
{ {
if (/^\/favor:</) if (/^\/favor:</)
...@@ -84,7 +84,7 @@ sub DeterminePlatform ...@@ -84,7 +84,7 @@ sub DeterminePlatform
sub IsNewer sub IsNewer
{ {
my ($newfile, $oldfile) = @_; my ($newfile, $oldfile) = @_;
if ( $oldfile ne 'src\tools\msvc\config.pl' if ( $oldfile ne 'src\tools\msvc\config.pl'
&& $oldfile ne 'src\tools\msvc\config_default.pl') && $oldfile ne 'src\tools\msvc\config_default.pl')
{ {
return 1 return 1
...@@ -105,8 +105,8 @@ sub IsNewer ...@@ -105,8 +105,8 @@ sub IsNewer
sub copyFile sub copyFile
{ {
my ($src, $dest) = @_; my ($src, $dest) = @_;
open(I,$src) || croak "Could not open $src"; open(I, $src) || croak "Could not open $src";
open(O,">$dest") || croak "Could not open $dest"; open(O, ">$dest") || croak "Could not open $dest";
while (<I>) while (<I>)
{ {
print O; print O;
...@@ -121,7 +121,8 @@ sub GenerateFiles ...@@ -121,7 +121,8 @@ sub GenerateFiles
my $bits = $self->{platform} eq 'Win32' ? 32 : 64; my $bits = $self->{platform} eq 'Win32' ? 32 : 64;
# Parse configure.in to get version numbers # Parse configure.in to get version numbers
open(C,"configure.in") || confess("Could not open configure.in for reading\n"); open(C, "configure.in")
|| confess("Could not open configure.in for reading\n");
while (<C>) while (<C>)
{ {
if (/^AC_INIT\(\[PostgreSQL\], \[([^\]]+)\]/) if (/^AC_INIT\(\[PostgreSQL\], \[([^\]]+)\]/)
...@@ -131,7 +132,7 @@ sub GenerateFiles ...@@ -131,7 +132,7 @@ sub GenerateFiles
{ {
confess "Bad format of version: $self->{strver}\n"; confess "Bad format of version: $self->{strver}\n";
} }
$self->{numver} = sprintf("%d%02d%02d", $1, $2, $3?$3:0); $self->{numver} = sprintf("%d%02d%02d", $1, $2, $3 ? $3 : 0);
$self->{majorver} = sprintf("%d.%d", $1, $2); $self->{majorver} = sprintf("%d.%d", $1, $2);
} }
} }
...@@ -139,18 +140,22 @@ sub GenerateFiles ...@@ -139,18 +140,22 @@ sub GenerateFiles
confess "Unable to parse configure.in for all variables!" confess "Unable to parse configure.in for all variables!"
if ($self->{strver} eq '' || $self->{numver} eq ''); if ($self->{strver} eq '' || $self->{numver} eq '');
if (IsNewer("src\\include\\pg_config_os.h","src\\include\\port\\win32.h")) if (IsNewer(
"src\\include\\pg_config_os.h", "src\\include\\port\\win32.h"))
{ {
print "Copying pg_config_os.h...\n"; print "Copying pg_config_os.h...\n";
copyFile("src\\include\\port\\win32.h","src\\include\\pg_config_os.h"); copyFile("src\\include\\port\\win32.h",
"src\\include\\pg_config_os.h");
} }
if (IsNewer("src\\include\\pg_config.h","src\\include\\pg_config.h.win32")) if (IsNewer(
"src\\include\\pg_config.h", "src\\include\\pg_config.h.win32"))
{ {
print "Generating pg_config.h...\n"; print "Generating pg_config.h...\n";
open(I,"src\\include\\pg_config.h.win32") open(I, "src\\include\\pg_config.h.win32")
|| confess "Could not open pg_config.h.win32\n"; || confess "Could not open pg_config.h.win32\n";
open(O,">src\\include\\pg_config.h") || confess "Could not write to pg_config.h\n"; open(O, ">src\\include\\pg_config.h")
|| confess "Could not write to pg_config.h\n";
while (<I>) while (<I>)
{ {
s{PG_VERSION "[^"]+"}{PG_VERSION "$self->{strver}"}; s{PG_VERSION "[^"]+"}{PG_VERSION "$self->{strver}"};
...@@ -159,22 +164,27 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY ...@@ -159,22 +164,27 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
print O; print O;
} }
print O "#define PG_MAJORVERSION \"$self->{majorver}\"\n"; print O "#define PG_MAJORVERSION \"$self->{majorver}\"\n";
print O "#define LOCALEDIR \"/share/locale\"\n" if ($self->{options}->{nls}); print O "#define LOCALEDIR \"/share/locale\"\n"
if ($self->{options}->{nls});
print O "/* defines added by config steps */\n"; print O "/* defines added by config steps */\n";
print O "#ifndef IGNORE_CONFIGURED_SETTINGS\n"; print O "#ifndef IGNORE_CONFIGURED_SETTINGS\n";
print O "#define USE_ASSERT_CHECKING 1\n" if ($self->{options}->{asserts}); print O "#define USE_ASSERT_CHECKING 1\n"
if ($self->{options}->{asserts});
print O "#define USE_INTEGER_DATETIMES 1\n" print O "#define USE_INTEGER_DATETIMES 1\n"
if ($self->{options}->{integer_datetimes}); if ($self->{options}->{integer_datetimes});
print O "#define USE_LDAP 1\n" if ($self->{options}->{ldap}); print O "#define USE_LDAP 1\n" if ($self->{options}->{ldap});
print O "#define HAVE_LIBZ 1\n" if ($self->{options}->{zlib}); print O "#define HAVE_LIBZ 1\n" if ($self->{options}->{zlib});
print O "#define USE_SSL 1\n" if ($self->{options}->{openssl}); print O "#define USE_SSL 1\n" if ($self->{options}->{openssl});
print O "#define ENABLE_NLS 1\n" if ($self->{options}->{nls}); print O "#define ENABLE_NLS 1\n" if ($self->{options}->{nls});
print O "#define BLCKSZ ",1024 * $self->{options}->{blocksize},"\n"; print O "#define BLCKSZ ", 1024 * $self->{options}->{blocksize}, "\n";
print O "#define RELSEG_SIZE ", print O "#define RELSEG_SIZE ",
(1024 / $self->{options}->{blocksize}) *$self->{options}->{segsize} * 1024, "\n"; (1024 / $self->{options}->{blocksize}) *
print O "#define XLOG_BLCKSZ ",1024 * $self->{options}->{wal_blocksize},"\n"; $self->{options}->{segsize} *
print O "#define XLOG_SEG_SIZE (",$self->{options}->{wal_segsize}, 1024, "\n";
print O "#define XLOG_BLCKSZ ",
1024 * $self->{options}->{wal_blocksize}, "\n";
print O "#define XLOG_SEG_SIZE (", $self->{options}->{wal_segsize},
" * 1024 * 1024)\n"; " * 1024 * 1024)\n";
if ($self->{options}->{float4byval}) if ($self->{options}->{float4byval})
...@@ -225,40 +235,43 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY ...@@ -225,40 +235,43 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
print O "#define DEF_PGPORT $port\n"; print O "#define DEF_PGPORT $port\n";
print O "#define DEF_PGPORT_STR \"$port\"\n"; print O "#define DEF_PGPORT_STR \"$port\"\n";
} }
print O "#define VAL_CONFIGURE \"" . $self->GetFakeConfigure() . "\"\n"; print O "#define VAL_CONFIGURE \""
. $self->GetFakeConfigure() . "\"\n";
print O "#endif /* IGNORE_CONFIGURED_SETTINGS */\n"; print O "#endif /* IGNORE_CONFIGURED_SETTINGS */\n";
close(O); close(O);
close(I); close(I);
} }
$self->GenerateDefFile("src\\interfaces\\libpq\\libpqdll.def", $self->GenerateDefFile(
"src\\interfaces\\libpq\\exports.txt","LIBPQ"); "src\\interfaces\\libpq\\libpqdll.def",
"src\\interfaces\\libpq\\exports.txt",
"LIBPQ");
$self->GenerateDefFile( $self->GenerateDefFile(
"src\\interfaces\\ecpg\\ecpglib\\ecpglib.def", "src\\interfaces\\ecpg\\ecpglib\\ecpglib.def",
"src\\interfaces\\ecpg\\ecpglib\\exports.txt", "src\\interfaces\\ecpg\\ecpglib\\exports.txt",
"LIBECPG" "LIBECPG");
);
$self->GenerateDefFile( $self->GenerateDefFile(
"src\\interfaces\\ecpg\\compatlib\\compatlib.def", "src\\interfaces\\ecpg\\compatlib\\compatlib.def",
"src\\interfaces\\ecpg\\compatlib\\exports.txt", "src\\interfaces\\ecpg\\compatlib\\exports.txt",
"LIBECPG_COMPAT" "LIBECPG_COMPAT");
);
$self->GenerateDefFile( $self->GenerateDefFile(
"src\\interfaces\\ecpg\\pgtypeslib\\pgtypeslib.def", "src\\interfaces\\ecpg\\pgtypeslib\\pgtypeslib.def",
"src\\interfaces\\ecpg\\pgtypeslib\\exports.txt", "src\\interfaces\\ecpg\\pgtypeslib\\exports.txt",
"LIBPGTYPES" "LIBPGTYPES");
);
if (IsNewer('src\backend\utils\fmgrtab.c','src\include\catalog\pg_proc.h')) if (IsNewer(
'src\backend\utils\fmgrtab.c', 'src\include\catalog\pg_proc.h'))
{ {
print "Generating fmgrtab.c and fmgroids.h...\n"; print "Generating fmgrtab.c and fmgroids.h...\n";
chdir('src\backend\utils'); chdir('src\backend\utils');
system("perl -I ../catalog Gen_fmgrtab.pl ../../../src/include/catalog/pg_proc.h"); system(
"perl -I ../catalog Gen_fmgrtab.pl ../../../src/include/catalog/pg_proc.h");
chdir('..\..\..'); chdir('..\..\..');
copyFile('src\backend\utils\fmgroids.h','src\include\utils\fmgroids.h'); copyFile('src\backend\utils\fmgroids.h',
'src\include\utils\fmgroids.h');
} }
if (IsNewer('src\include\utils\probes.h','src\backend\utils\probes.d')) if (IsNewer('src\include\utils\probes.h', 'src\backend\utils\probes.d'))
{ {
print "Generating probes.h...\n"; print "Generating probes.h...\n";
system( system(
...@@ -267,7 +280,9 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY ...@@ -267,7 +280,9 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
} }
if ($self->{options}->{python} if ($self->{options}->{python}
&& IsNewer('src\pl\plpython\spiexceptions.h','src\include\backend\errcodes.txt')) && IsNewer(
'src\pl\plpython\spiexceptions.h',
'src\include\backend\errcodes.txt'))
{ {
print "Generating spiexceptions.h...\n"; print "Generating spiexceptions.h...\n";
system( system(
...@@ -275,16 +290,21 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY ...@@ -275,16 +290,21 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
); );
} }
if (IsNewer('src\include\utils\errcodes.h','src\backend\utils\errcodes.txt')) if (IsNewer(
'src\include\utils\errcodes.h',
'src\backend\utils\errcodes.txt'))
{ {
print "Generating errcodes.h...\n"; print "Generating errcodes.h...\n";
system( system(
'perl src\backend\utils\generate-errcodes.pl src\backend\utils\errcodes.txt > src\backend\utils\errcodes.h' 'perl src\backend\utils\generate-errcodes.pl src\backend\utils\errcodes.txt > src\backend\utils\errcodes.h'
); );
copyFile('src\backend\utils\errcodes.h','src\include\utils\errcodes.h'); copyFile('src\backend\utils\errcodes.h',
'src\include\utils\errcodes.h');
} }
if (IsNewer('src\pl\plpgsql\src\plerrcodes.h','src\backend\utils\errcodes.txt')) if (IsNewer(
'src\pl\plpgsql\src\plerrcodes.h',
'src\backend\utils\errcodes.txt'))
{ {
print "Generating plerrcodes.h...\n"; print "Generating plerrcodes.h...\n";
system( system(
...@@ -292,12 +312,9 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY ...@@ -292,12 +312,9 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
); );
} }
if ( if (IsNewer(
IsNewer(
'src\backend\utils\sort\qsort_tuple.c', 'src\backend\utils\sort\qsort_tuple.c',
'src\backend\utils\sort\gen_qsort_tuple.pl' 'src\backend\utils\sort\gen_qsort_tuple.pl'))
)
)
{ {
print "Generating qsort_tuple.c...\n"; print "Generating qsort_tuple.c...\n";
system( system(
...@@ -305,14 +322,18 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY ...@@ -305,14 +322,18 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
); );
} }
if (IsNewer('src\interfaces\libpq\libpq.rc','src\interfaces\libpq\libpq.rc.in')) if (IsNewer(
'src\interfaces\libpq\libpq.rc',
'src\interfaces\libpq\libpq.rc.in'))
{ {
print "Generating libpq.rc...\n"; print "Generating libpq.rc...\n";
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
localtime(time);
my $d = ($year - 100) . "$yday"; my $d = ($year - 100) . "$yday";
open(I,'<', 'src\interfaces\libpq\libpq.rc.in') open(I, '<', 'src\interfaces\libpq\libpq.rc.in')
|| confess "Could not open libpq.rc.in"; || confess "Could not open libpq.rc.in";
open(O,'>', 'src\interfaces\libpq\libpq.rc') || confess "Could not open libpq.rc"; open(O, '>', 'src\interfaces\libpq\libpq.rc')
|| confess "Could not open libpq.rc";
while (<I>) while (<I>)
{ {
s/(VERSION.*),0/$1,$d/; s/(VERSION.*),0/$1,$d/;
...@@ -322,7 +343,7 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY ...@@ -322,7 +343,7 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
close(O); close(O);
} }
if (IsNewer('src\bin\psql\sql_help.h','src\bin\psql\create_help.pl')) if (IsNewer('src\bin\psql\sql_help.h', 'src\bin\psql\create_help.pl'))
{ {
print "Generating sql_help.h...\n"; print "Generating sql_help.h...\n";
chdir('src\bin\psql'); chdir('src\bin\psql');
...@@ -330,7 +351,9 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY ...@@ -330,7 +351,9 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
chdir('..\..\..'); chdir('..\..\..');
} }
if (IsNewer('src\interfaces\ecpg\preproc\preproc.y','src\backend\parser\gram.y')) if (IsNewer(
'src\interfaces\ecpg\preproc\preproc.y',
'src\backend\parser\gram.y'))
{ {
print "Generating preproc.y...\n"; print "Generating preproc.y...\n";
chdir('src\interfaces\ecpg\preproc'); chdir('src\interfaces\ecpg\preproc');
...@@ -338,15 +361,12 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY ...@@ -338,15 +361,12 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
chdir('..\..\..\..'); chdir('..\..\..\..');
} }
if ( if (IsNewer(
IsNewer(
'src\interfaces\ecpg\include\ecpg_config.h', 'src\interfaces\ecpg\include\ecpg_config.h',
'src\interfaces\ecpg\include\ecpg_config.h.in' 'src\interfaces\ecpg\include\ecpg_config.h.in'))
)
)
{ {
print "Generating ecpg_config.h...\n"; print "Generating ecpg_config.h...\n";
open(O,'>','src\interfaces\ecpg\include\ecpg_config.h') open(O, '>', 'src\interfaces\ecpg\include\ecpg_config.h')
|| confess "Could not open ecpg_config.h"; || confess "Could not open ecpg_config.h";
print O <<EOF; print O <<EOF;
#if (_MSC_VER > 1200) #if (_MSC_VER > 1200)
...@@ -362,9 +382,9 @@ EOF ...@@ -362,9 +382,9 @@ EOF
unless (-f "src\\port\\pg_config_paths.h") unless (-f "src\\port\\pg_config_paths.h")
{ {
print "Generating pg_config_paths.h...\n"; print "Generating pg_config_paths.h...\n";
open(O,'>', 'src\port\pg_config_paths.h') open(O, '>', 'src\port\pg_config_paths.h')
|| confess "Could not open pg_config_paths.h"; || confess "Could not open pg_config_paths.h";
print O <<EOF; print O <<EOF;
#define PGBINDIR "/bin" #define PGBINDIR "/bin"
#define PGSHAREDIR "/share" #define PGSHAREDIR "/share"
#define SYSCONFDIR "/etc" #define SYSCONFDIR "/etc"
...@@ -389,7 +409,9 @@ EOF ...@@ -389,7 +409,9 @@ EOF
foreach my $bki (@allbki) foreach my $bki (@allbki)
{ {
next if $bki eq ""; next if $bki eq "";
if (IsNewer('src/backend/catalog/postgres.bki', "src/include/catalog/$bki")) if (IsNewer(
'src/backend/catalog/postgres.bki',
"src/include/catalog/$bki"))
{ {
print "Generating postgres.bki and schemapg.h...\n"; print "Generating postgres.bki and schemapg.h...\n";
chdir('src\backend\catalog'); chdir('src\backend\catalog');
...@@ -398,13 +420,15 @@ EOF ...@@ -398,13 +420,15 @@ EOF
"perl genbki.pl -I../../../src/include/catalog --set-version=$self->{majorver} $bki_srcs" "perl genbki.pl -I../../../src/include/catalog --set-version=$self->{majorver} $bki_srcs"
); );
chdir('..\..\..'); chdir('..\..\..');
copyFile('src\backend\catalog\schemapg.h', copyFile(
'src\backend\catalog\schemapg.h',
'src\include\catalog\schemapg.h'); 'src\include\catalog\schemapg.h');
last; last;
} }
} }
open(O, ">doc/src/sgml/version.sgml") || croak "Could not write to version.sgml\n"; open(O, ">doc/src/sgml/version.sgml")
|| croak "Could not write to version.sgml\n";
print O <<EOF; print O <<EOF;
<!ENTITY version "$self->{strver}"> <!ENTITY version "$self->{strver}">
<!ENTITY majorversion "$self->{majorver}"> <!ENTITY majorversion "$self->{majorver}">
...@@ -414,13 +438,13 @@ EOF ...@@ -414,13 +438,13 @@ EOF
sub GenerateDefFile sub GenerateDefFile
{ {
my ($self, $deffile, $txtfile, $libname) = @_; my ($self, $deffile, $txtfile, $libname) = @_;
if (IsNewer($deffile,$txtfile)) if (IsNewer($deffile, $txtfile))
{ {
print "Generating $deffile...\n"; print "Generating $deffile...\n";
open(I,$txtfile) || confess("Could not open $txtfile\n"); open(I, $txtfile) || confess("Could not open $txtfile\n");
open(O,">$deffile") || confess("Could not open $deffile\n"); open(O, ">$deffile") || confess("Could not open $deffile\n");
print O "LIBRARY $libname\nEXPORTS\n"; print O "LIBRARY $libname\nEXPORTS\n";
while (<I>) while (<I>)
{ {
...@@ -438,8 +462,9 @@ sub AddProject ...@@ -438,8 +462,9 @@ sub AddProject
{ {
my ($self, $name, $type, $folder, $initialdir) = @_; my ($self, $name, $type, $folder, $initialdir) = @_;
my $proj = VSObjectFactory::CreateProject($self->{vcver}, $name, $type, $self); my $proj =
push @{$self->{projects}->{$folder}}, $proj; VSObjectFactory::CreateProject($self->{vcver}, $name, $type, $self);
push @{ $self->{projects}->{$folder} }, $proj;
$proj->AddDir($initialdir) if ($initialdir); $proj->AddDir($initialdir) if ($initialdir);
if ($self->{options}->{zlib}) if ($self->{options}->{zlib})
{ {
...@@ -449,8 +474,10 @@ sub AddProject ...@@ -449,8 +474,10 @@ sub AddProject
if ($self->{options}->{openssl}) if ($self->{options}->{openssl})
{ {
$proj->AddIncludeDir($self->{options}->{openssl} . '\include'); $proj->AddIncludeDir($self->{options}->{openssl} . '\include');
$proj->AddLibrary($self->{options}->{openssl} . '\lib\VC\ssleay32.lib', 1); $proj->AddLibrary(
$proj->AddLibrary($self->{options}->{openssl} . '\lib\VC\libeay32.lib', 1); $self->{options}->{openssl} . '\lib\VC\ssleay32.lib', 1);
$proj->AddLibrary(
$self->{options}->{openssl} . '\lib\VC\libeay32.lib', 1);
} }
if ($self->{options}->{nls}) if ($self->{options}->{nls})
{ {
...@@ -461,8 +488,10 @@ sub AddProject ...@@ -461,8 +488,10 @@ sub AddProject
{ {
$proj->AddIncludeDir($self->{options}->{krb5} . '\inc\krb5'); $proj->AddIncludeDir($self->{options}->{krb5} . '\inc\krb5');
$proj->AddLibrary($self->{options}->{krb5} . '\lib\i386\krb5_32.lib'); $proj->AddLibrary($self->{options}->{krb5} . '\lib\i386\krb5_32.lib');
$proj->AddLibrary($self->{options}->{krb5} . '\lib\i386\comerr32.lib'); $proj->AddLibrary(
$proj->AddLibrary($self->{options}->{krb5} . '\lib\i386\gssapi32.lib'); $self->{options}->{krb5} . '\lib\i386\comerr32.lib');
$proj->AddLibrary(
$self->{options}->{krb5} . '\lib\i386\gssapi32.lib');
} }
if ($self->{options}->{iconv}) if ($self->{options}->{iconv})
{ {
...@@ -488,23 +517,23 @@ sub Save ...@@ -488,23 +517,23 @@ sub Save
my %flduid; my %flduid;
$self->GenerateFiles(); $self->GenerateFiles();
foreach my $fld (keys %{$self->{projects}}) foreach my $fld (keys %{ $self->{projects} })
{ {
foreach my $proj (@{$self->{projects}->{$fld}}) foreach my $proj (@{ $self->{projects}->{$fld} })
{ {
$proj->Save(); $proj->Save();
} }
} }
open(SLN,">pgsql.sln") || croak "Could not write to pgsql.sln\n"; open(SLN, ">pgsql.sln") || croak "Could not write to pgsql.sln\n";
print SLN <<EOF; print SLN <<EOF;
Microsoft Visual Studio Solution File, Format Version $self->{solutionFileVersion} Microsoft Visual Studio Solution File, Format Version $self->{solutionFileVersion}
# $self->{visualStudioName} # $self->{visualStudioName}
EOF EOF
foreach my $fld (keys %{$self->{projects}}) foreach my $fld (keys %{ $self->{projects} })
{ {
foreach my $proj (@{$self->{projects}->{$fld}}) foreach my $proj (@{ $self->{projects}->{$fld} })
{ {
print SLN <<EOF; print SLN <<EOF;
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "$proj->{name}", "$proj->{name}$proj->{filenameExtension}", "$proj->{guid}" Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "$proj->{name}", "$proj->{name}$proj->{filenameExtension}", "$proj->{guid}"
...@@ -530,9 +559,9 @@ Global ...@@ -530,9 +559,9 @@ Global
GlobalSection(ProjectConfigurationPlatforms) = postSolution GlobalSection(ProjectConfigurationPlatforms) = postSolution
EOF EOF
foreach my $fld (keys %{$self->{projects}}) foreach my $fld (keys %{ $self->{projects} })
{ {
foreach my $proj (@{$self->{projects}->{$fld}}) foreach my $proj (@{ $self->{projects}->{$fld} })
{ {
print SLN <<EOF; print SLN <<EOF;
$proj->{guid}.Debug|$self->{platform}.ActiveCfg = Debug|$self->{platform} $proj->{guid}.Debug|$self->{platform}.ActiveCfg = Debug|$self->{platform}
...@@ -551,10 +580,10 @@ EOF ...@@ -551,10 +580,10 @@ EOF
GlobalSection(NestedProjects) = preSolution GlobalSection(NestedProjects) = preSolution
EOF EOF
foreach my $fld (keys %{$self->{projects}}) foreach my $fld (keys %{ $self->{projects} })
{ {
next if ($fld eq ""); next if ($fld eq "");
foreach my $proj (@{$self->{projects}->{$fld}}) foreach my $proj (@{ $self->{projects}->{$fld} })
{ {
print SLN "\t\t$proj->{guid} = $flduid{$fld}\n"; print SLN "\t\t$proj->{guid} = $flduid{$fld}\n";
} }
...@@ -573,18 +602,19 @@ sub GetFakeConfigure ...@@ -573,18 +602,19 @@ sub GetFakeConfigure
my $cfg = '--enable-thread-safety'; my $cfg = '--enable-thread-safety';
$cfg .= ' --enable-cassert' if ($self->{options}->{asserts}); $cfg .= ' --enable-cassert' if ($self->{options}->{asserts});
$cfg .= ' --enable-integer-datetimes' if ($self->{options}->{integer_datetimes}); $cfg .= ' --enable-integer-datetimes'
if ($self->{options}->{integer_datetimes});
$cfg .= ' --enable-nls' if ($self->{options}->{nls}); $cfg .= ' --enable-nls' if ($self->{options}->{nls});
$cfg .= ' --with-ldap' if ($self->{options}->{ldap}); $cfg .= ' --with-ldap' if ($self->{options}->{ldap});
$cfg .= ' --without-zlib' unless ($self->{options}->{zlib}); $cfg .= ' --without-zlib' unless ($self->{options}->{zlib});
$cfg .= ' --with-openssl' if ($self->{options}->{ssl}); $cfg .= ' --with-openssl' if ($self->{options}->{ssl});
$cfg .= ' --with-ossp-uuid' if ($self->{options}->{uuid}); $cfg .= ' --with-ossp-uuid' if ($self->{options}->{uuid});
$cfg .= ' --with-libxml' if ($self->{options}->{xml}); $cfg .= ' --with-libxml' if ($self->{options}->{xml});
$cfg .= ' --with-libxslt' if ($self->{options}->{xslt}); $cfg .= ' --with-libxslt' if ($self->{options}->{xslt});
$cfg .= ' --with-krb5' if ($self->{options}->{krb5}); $cfg .= ' --with-krb5' if ($self->{options}->{krb5});
$cfg .= ' --with-tcl' if ($self->{options}->{tcl}); $cfg .= ' --with-tcl' if ($self->{options}->{tcl});
$cfg .= ' --with-perl' if ($self->{options}->{perl}); $cfg .= ' --with-perl' if ($self->{options}->{perl});
$cfg .= ' --with-python' if ($self->{options}->{python}); $cfg .= ' --with-python' if ($self->{options}->{python});
return $cfg; return $cfg;
} }
...@@ -602,12 +632,12 @@ use base qw(Solution); ...@@ -602,12 +632,12 @@ use base qw(Solution);
sub new sub new
{ {
my $classname = shift; my $classname = shift;
my $self = $classname->SUPER::_new(@_); my $self = $classname->SUPER::_new(@_);
bless($self, $classname); bless($self, $classname);
$self->{solutionFileVersion} = '9.00'; $self->{solutionFileVersion} = '9.00';
$self->{vcver} = '8.00'; $self->{vcver} = '8.00';
$self->{visualStudioName} = 'Visual Studio 2005'; $self->{visualStudioName} = 'Visual Studio 2005';
return $self; return $self;
} }
...@@ -625,12 +655,12 @@ use base qw(Solution); ...@@ -625,12 +655,12 @@ use base qw(Solution);
sub new sub new
{ {
my $classname = shift; my $classname = shift;
my $self = $classname->SUPER::_new(@_); my $self = $classname->SUPER::_new(@_);
bless($self, $classname); bless($self, $classname);
$self->{solutionFileVersion} = '10.00'; $self->{solutionFileVersion} = '10.00';
$self->{vcver} = '9.00'; $self->{vcver} = '9.00';
$self->{visualStudioName} = 'Visual Studio 2008'; $self->{visualStudioName} = 'Visual Studio 2008';
return $self; return $self;
} }
...@@ -649,12 +679,12 @@ use base qw(Solution); ...@@ -649,12 +679,12 @@ use base qw(Solution);
sub new sub new
{ {
my $classname = shift; my $classname = shift;
my $self = $classname->SUPER::_new(@_); my $self = $classname->SUPER::_new(@_);
bless($self, $classname); bless($self, $classname);
$self->{solutionFileVersion} = '11.00'; $self->{solutionFileVersion} = '11.00';
$self->{vcver} = '10.00'; $self->{vcver} = '10.00';
$self->{visualStudioName} = 'Visual Studio 2010'; $self->{visualStudioName} = 'Visual Studio 2010';
return $self; return $self;
} }
......
src/tools/msvc/VCBuildProject.pm
View file @ 042d9ffc
...@@ -14,7 +14,7 @@ use base qw(Project); ...@@ -14,7 +14,7 @@ use base qw(Project);
sub _new sub _new
{ {
my $classname = shift; my $classname = shift;
my $self = $classname->SUPER::_new(@_); my $self = $classname->SUPER::_new(@_);
bless($self, $classname); bless($self, $classname);
$self->{filenameExtension} = '.vcproj'; $self->{filenameExtension} = '.vcproj';
...@@ -32,10 +32,21 @@ sub WriteHeader ...@@ -32,10 +32,21 @@ sub WriteHeader
<Platforms><Platform Name="$self->{platform}"/></Platforms> <Platforms><Platform Name="$self->{platform}"/></Platforms>
<Configurations> <Configurations>
EOF EOF
$self->WriteConfiguration($f, 'Debug', $self->WriteConfiguration(
{defs=>'_DEBUG;DEBUG=1;', wholeopt=>0, opt=>0, strpool=>'false', runtime=>3}); $f, 'Debug',
$self->WriteConfiguration($f, 'Release', { defs => '_DEBUG;DEBUG=1;',
{defs=>'', wholeopt=>0, opt=>3, strpool=>'true', runtime=>2}); wholeopt => 0,
opt => 0,
strpool => 'false',
runtime => 3 });
$self->WriteConfiguration(
$f,
'Release',
{ defs => '',
wholeopt => 0,
opt => 3,
strpool => 'true',
runtime => 2 });
print $f <<EOF; print $f <<EOF;
</Configurations> </Configurations>
EOF EOF
...@@ -50,43 +61,49 @@ sub WriteFiles ...@@ -50,43 +61,49 @@ sub WriteFiles
EOF EOF
my @dirstack = (); my @dirstack = ();
my %uniquefiles; my %uniquefiles;
foreach my $fileNameWithPath (sort keys %{$self->{files}}) foreach my $fileNameWithPath (sort keys %{ $self->{files} })
{ {
confess "Bad format filename '$fileNameWithPath'\n" confess "Bad format filename '$fileNameWithPath'\n"
unless ($fileNameWithPath =~ /^(.*)\\([^\\]+)\.[r]?[cyl]$/); unless ($fileNameWithPath =~ /^(.*)\\([^\\]+)\.[r]?[cyl]$/);
my $dir = $1; my $dir = $1;
my $file = $2; my $file = $2;
# Walk backwards down the directory stack and close any dirs we're done with # Walk backwards down the directory stack and close any dirs we're done with
while ($#dirstack >= 0) while ($#dirstack >= 0)
{ {
if (join('\\',@dirstack) eq substr($dir, 0, length(join('\\',@dirstack)))) if (join('\\', @dirstack) eq
substr($dir, 0, length(join('\\', @dirstack))))
{ {
last if (length($dir) == length(join('\\',@dirstack))); last if (length($dir) == length(join('\\', @dirstack)));
last if (substr($dir, length(join('\\',@dirstack)),1) eq '\\'); last
if (substr($dir, length(join('\\', @dirstack)), 1) eq '\\');
} }
print $f ' ' x $#dirstack . " </Filter>\n"; print $f ' ' x $#dirstack . " </Filter>\n";
pop @dirstack; pop @dirstack;
} }
# Now walk forwards and create whatever directories are needed # Now walk forwards and create whatever directories are needed
while (join('\\',@dirstack) ne $dir) while (join('\\', @dirstack) ne $dir)
{ {
my $left = substr($dir, length(join('\\',@dirstack))); my $left = substr($dir, length(join('\\', @dirstack)));
$left =~ s/^\\//; $left =~ s/^\\//;
my @pieces = split /\\/, $left; my @pieces = split /\\/, $left;
push @dirstack, $pieces[0]; push @dirstack, $pieces[0];
print $f ' ' x $#dirstack . " <Filter Name=\"$pieces[0]\" Filter=\"\">\n"; print $f ' ' x $#dirstack
. " <Filter Name=\"$pieces[0]\" Filter=\"\">\n";
} }
print $f ' ' x $#dirstack . " <File RelativePath=\"$fileNameWithPath\""; print $f ' ' x $#dirstack
. " <File RelativePath=\"$fileNameWithPath\"";
if ($fileNameWithPath =~ /\.y$/) if ($fileNameWithPath =~ /\.y$/)
{ {
my $of = $fileNameWithPath; my $of = $fileNameWithPath;
$of =~ s/\.y$/.c/; $of =~ s/\.y$/.c/;
$of =~ s{^src\\pl\\plpgsql\\src\\gram.c$}{src\\pl\\plpgsql\\src\\pl_gram.c}; $of =~
s{^src\\pl\\plpgsql\\src\\gram.c$}{src\\pl\\plpgsql\\src\\pl_gram.c};
print $f '>' print $f '>'
. $self->GenerateCustomTool('Running bison on ' . $fileNameWithPath, . $self->GenerateCustomTool(
'Running bison on ' . $fileNameWithPath,
"perl src\\tools\\msvc\\pgbison.pl $fileNameWithPath", $of) "perl src\\tools\\msvc\\pgbison.pl $fileNameWithPath", $of)
. '</File>' . "\n"; . '</File>' . "\n";
} }
...@@ -95,7 +112,8 @@ EOF ...@@ -95,7 +112,8 @@ EOF
my $of = $fileNameWithPath; my $of = $fileNameWithPath;
$of =~ s/\.l$/.c/; $of =~ s/\.l$/.c/;
print $f '>' print $f '>'
. $self->GenerateCustomTool('Running flex on ' . $fileNameWithPath, . $self->GenerateCustomTool(
'Running flex on ' . $fileNameWithPath,
"perl src\\tools\\msvc\\pgflex.pl $fileNameWithPath", $of) "perl src\\tools\\msvc\\pgflex.pl $fileNameWithPath", $of)
. '</File>' . "\n"; . '</File>' . "\n";
} }
...@@ -139,7 +157,8 @@ EOF ...@@ -139,7 +157,8 @@ EOF
sub WriteConfiguration sub WriteConfiguration
{ {
my ($self, $f, $cfgname, $p) = @_; my ($self, $f, $cfgname, $p) = @_;
my $cfgtype = ($self->{type} eq "exe")?1:($self->{type} eq "dll"?2:4); my $cfgtype =
($self->{type} eq "exe") ? 1 : ($self->{type} eq "dll" ? 2 : 4);
my $libs = $self->GetAdditionalLinkerDependencies($cfgname, ' '); my $libs = $self->GetAdditionalLinkerDependencies($cfgname, ' ');
my $targetmachine = $self->{platform} eq 'Win32' ? 1 : 17; my $targetmachine = $self->{platform} eq 'Win32' ? 1 : 17;
...@@ -168,7 +187,8 @@ EOF ...@@ -168,7 +187,8 @@ EOF
EOF EOF
if ($self->{disablelinkerwarnings}) if ($self->{disablelinkerwarnings})
{ {
print $f "\t\tAdditionalOptions=\"/ignore:$self->{disablelinkerwarnings}\"\n"; print $f
"\t\tAdditionalOptions=\"/ignore:$self->{disablelinkerwarnings}\"\n";
} }
if ($self->{implib}) if ($self->{implib})
{ {
...@@ -202,7 +222,7 @@ sub WriteReferences ...@@ -202,7 +222,7 @@ sub WriteReferences
{ {
my ($self, $f) = @_; my ($self, $f) = @_;
print $f " <References>\n"; print $f " <References>\n";
foreach my $ref (@{$self->{references}}) foreach my $ref (@{ $self->{references} })
{ {
print $f print $f
" <ProjectReference ReferencedProjectIdentifier=\"$ref->{guid}\" Name=\"$ref->{name}\" />\n"; " <ProjectReference ReferencedProjectIdentifier=\"$ref->{guid}\" Name=\"$ref->{name}\" />\n";
...@@ -216,7 +236,7 @@ sub GenerateCustomTool ...@@ -216,7 +236,7 @@ sub GenerateCustomTool
if (!defined($cfg)) if (!defined($cfg))
{ {
return $self->GenerateCustomTool($desc, $tool, $output, 'Debug') return $self->GenerateCustomTool($desc, $tool, $output, 'Debug')
.$self->GenerateCustomTool($desc, $tool, $output, 'Release'); . $self->GenerateCustomTool($desc, $tool, $output, 'Release');
} }
return return
"<FileConfiguration Name=\"$cfg|$self->{platform}\"><Tool Name=\"VCCustomBuildTool\" Description=\"$desc\" CommandLine=\"$tool\" AdditionalDependencies=\"\" Outputs=\"$output\" /></FileConfiguration>"; "<FileConfiguration Name=\"$cfg|$self->{platform}\"><Tool Name=\"VCCustomBuildTool\" Description=\"$desc\" CommandLine=\"$tool\" AdditionalDependencies=\"\" Outputs=\"$output\" /></FileConfiguration>";
...@@ -235,7 +255,7 @@ use base qw(VCBuildProject); ...@@ -235,7 +255,7 @@ use base qw(VCBuildProject);
sub new sub new
{ {
my $classname = shift; my $classname = shift;
my $self = $classname->SUPER::_new(@_); my $self = $classname->SUPER::_new(@_);
bless($self, $classname); bless($self, $classname);
$self->{vcver} = '8.00'; $self->{vcver} = '8.00';
...@@ -256,7 +276,7 @@ use base qw(VCBuildProject); ...@@ -256,7 +276,7 @@ use base qw(VCBuildProject);
sub new sub new
{ {
my $classname = shift; my $classname = shift;
my $self = $classname->SUPER::_new(@_); my $self = $classname->SUPER::_new(@_);
bless($self, $classname); bless($self, $classname);
$self->{vcver} = '9.00'; $self->{vcver} = '9.00';
......
src/tools/msvc/VSObjectFactory.pm
View file @ 042d9ffc
...@@ -17,7 +17,7 @@ use VCBuildProject; ...@@ -17,7 +17,7 @@ use VCBuildProject;
use MSBuildProject; use MSBuildProject;
our (@ISA, @EXPORT); our (@ISA, @EXPORT);
@ISA = qw(Exporter); @ISA = qw(Exporter);
@EXPORT = qw(CreateSolution CreateProject DetermineVisualStudioVersion); @EXPORT = qw(CreateSolution CreateProject DetermineVisualStudioVersion);
sub CreateSolution sub CreateSolution
...@@ -81,12 +81,12 @@ sub DetermineVisualStudioVersion ...@@ -81,12 +81,12 @@ sub DetermineVisualStudioVersion
if (!defined($nmakeVersion)) if (!defined($nmakeVersion))
{ {
# Determine version of nmake command, to set proper version of visual studio # Determine version of nmake command, to set proper version of visual studio
# we use nmake as it has existed for a long time and still exists in visual studio 2010 # we use nmake as it has existed for a long time and still exists in visual studio 2010
open(P,"nmake /? 2>&1 |") open(P, "nmake /? 2>&1 |")
|| croak || croak
"Unable to determine Visual Studio version: The nmake command wasn't found."; "Unable to determine Visual Studio version: The nmake command wasn't found.";
while(<P>) while (<P>)
{ {
chomp; chomp;
if (/(\d+)\.(\d+)\.\d+(\.\d+)?$/) if (/(\d+)\.(\d+)\.\d+(\.\d+)?$/)
...@@ -96,17 +96,17 @@ sub DetermineVisualStudioVersion ...@@ -96,17 +96,17 @@ sub DetermineVisualStudioVersion
} }
close(P); close(P);
} }
elsif($nmakeVersion =~ /(\d+)\.(\d+)\.\d+(\.\d+)?$/) elsif ($nmakeVersion =~ /(\d+)\.(\d+)\.\d+(\.\d+)?$/)
{ {
return _GetVisualStudioVersion($1, $2); return _GetVisualStudioVersion($1, $2);
} }
croak croak
"Unable to determine Visual Studio version: The nmake version could not be determined."; "Unable to determine Visual Studio version: The nmake version could not be determined.";
} }
sub _GetVisualStudioVersion sub _GetVisualStudioVersion
{ {
my($major, $minor) = @_; my ($major, $minor) = @_;
if ($major > 10) if ($major > 10)
{ {
carp carp
......
src/tools/msvc/build.pl
View file @ 042d9ffc
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
BEGIN BEGIN
{ {
chdir("../../..") if (-d "../msvc" && -d "../../../src"); chdir("../../..") if (-d "../msvc" && -d "../../../src");
} }
...@@ -37,8 +37,8 @@ my $vcver = Mkvcbuild::mkvcbuild($config); ...@@ -37,8 +37,8 @@ my $vcver = Mkvcbuild::mkvcbuild($config);
# check what sort of build we are doing # check what sort of build we are doing
my $bconf = $ENV{CONFIG} || "Release"; my $bconf = $ENV{CONFIG} || "Release";
my $buildwhat = $ARGV[1] || ""; my $buildwhat = $ARGV[1] || "";
if ($ARGV[0] eq 'DEBUG') if ($ARGV[0] eq 'DEBUG')
{ {
$bconf = "Debug"; $bconf = "Debug";
...@@ -52,7 +52,8 @@ elsif ($ARGV[0] ne "RELEASE") ...@@ -52,7 +52,8 @@ elsif ($ARGV[0] ne "RELEASE")
if ($buildwhat and $vcver eq '10.00') if ($buildwhat and $vcver eq '10.00')
{ {
system("msbuild $buildwhat.vcxproj /verbosity:detailed /p:Configuration=$bconf"); system(
"msbuild $buildwhat.vcxproj /verbosity:detailed /p:Configuration=$bconf");
} }
elsif ($buildwhat) elsif ($buildwhat)
{ {
......
src/tools/msvc/builddoc.pl
View file @ 042d9ffc
...@@ -9,10 +9,10 @@ use strict; ...@@ -9,10 +9,10 @@ use strict;
use File::Copy; use File::Copy;
use Cwd qw(abs_path getcwd); use Cwd qw(abs_path getcwd);
my $startdir = getcwd(); my $startdir = getcwd();
my $openjade = 'openjade-1.3.1'; my $openjade = 'openjade-1.3.1';
my $dsssl = 'docbook-dsssl-1.79'; my $dsssl = 'docbook-dsssl-1.79';
chdir '../../..' if (-d '../msvc' && -d '../../../src'); chdir '../../..' if (-d '../msvc' && -d '../../../src');
...@@ -26,7 +26,7 @@ die "bad DOCROOT '$docroot'" unless ($docroot && -d $docroot); ...@@ -26,7 +26,7 @@ die "bad DOCROOT '$docroot'" unless ($docroot && -d $docroot);
my @notfound; my @notfound;
foreach my $dir ('docbook', $openjade, $dsssl) foreach my $dir ('docbook', $openjade, $dsssl)
{ {
push(@notfound,$dir) unless -d "$docroot/$dir"; push(@notfound, $dir) unless -d "$docroot/$dir";
} }
missing() if @notfound; missing() if @notfound;
...@@ -35,7 +35,8 @@ renamefiles(); ...@@ -35,7 +35,8 @@ renamefiles();
chdir 'doc/src/sgml'; chdir 'doc/src/sgml';
$ENV{SGML_CATALOG_FILES} = "$docroot/$openjade/dsssl/catalog;" ."$docroot/docbook/docbook.cat"; $ENV{SGML_CATALOG_FILES} =
"$docroot/$openjade/dsssl/catalog;" . "$docroot/docbook/docbook.cat";
my $cmd; my $cmd;
...@@ -43,45 +44,46 @@ my $cmd; ...@@ -43,45 +44,46 @@ my $cmd;
# can't die on "failure" # can't die on "failure"
$cmd = $cmd =
"perl mk_feature_tables.pl YES " "perl mk_feature_tables.pl YES "
."../../../src/backend/catalog/sql_feature_packages.txt " . "../../../src/backend/catalog/sql_feature_packages.txt "
."../../../src/backend/catalog/sql_features.txt " . "../../../src/backend/catalog/sql_features.txt "
."> features-supported.sgml"; . "> features-supported.sgml";
system($cmd); system($cmd);
die "features_supported" if $?; die "features_supported" if $?;
$cmd = $cmd =
"perl mk_feature_tables.pl NO " "perl mk_feature_tables.pl NO "
."\"../../../src/backend/catalog/sql_feature_packages.txt\" " . "\"../../../src/backend/catalog/sql_feature_packages.txt\" "
."\"../../../src/backend/catalog/sql_features.txt\" " . "\"../../../src/backend/catalog/sql_features.txt\" "
."> features-unsupported.sgml"; . "> features-unsupported.sgml";
system($cmd); system($cmd);
die "features_unsupported" if $?; die "features_unsupported" if $?;
$cmd ="perl generate-errcodes-table.pl \"../../../src/backend/utils/errcodes.txt\" " $cmd =
."> errcodes-table.sgml"; "perl generate-errcodes-table.pl \"../../../src/backend/utils/errcodes.txt\" "
. "> errcodes-table.sgml";
system($cmd); system($cmd);
die "errcodes-table" if $?; die "errcodes-table" if $?;
print "Running first build...\n"; print "Running first build...\n";
$cmd = $cmd =
"\"$docroot/$openjade/bin/openjade\" -V html-index -wall " "\"$docroot/$openjade/bin/openjade\" -V html-index -wall "
."-wno-unused-param -wno-empty -D . -c \"$docroot/$dsssl/catalog\" " . "-wno-unused-param -wno-empty -D . -c \"$docroot/$dsssl/catalog\" "
."-d stylesheet.dsl -i output-html -t sgml postgres.sgml 2>&1 " . "-d stylesheet.dsl -i output-html -t sgml postgres.sgml 2>&1 "
."| findstr /V \"DTDDECL catalog entries are not supported\" "; . "| findstr /V \"DTDDECL catalog entries are not supported\" ";
system($cmd); # die "openjade" if $?; system($cmd); # die "openjade" if $?;
print "Running collateindex...\n"; print "Running collateindex...\n";
$cmd = $cmd = "perl \"$docroot/$dsssl/bin/collateindex.pl\" -f -g -i bookindex "
"perl \"$docroot/$dsssl/bin/collateindex.pl\" -f -g -i bookindex "."-o bookindex.sgml HTML.index"; . "-o bookindex.sgml HTML.index";
system($cmd); system($cmd);
die "collateindex" if $?; die "collateindex" if $?;
mkdir "html"; mkdir "html";
print "Running second build...\n"; print "Running second build...\n";
$cmd = $cmd =
"\"$docroot/$openjade/bin/openjade\" -wall -wno-unused-param -wno-empty " "\"$docroot/$openjade/bin/openjade\" -wall -wno-unused-param -wno-empty "
."-D . -c \"$docroot/$dsssl/catalog\" -d stylesheet.dsl -t sgml " . "-D . -c \"$docroot/$dsssl/catalog\" -d stylesheet.dsl -t sgml "
."-i output-html -i include-index postgres.sgml 2>&1 " . "-i output-html -i include-index postgres.sgml 2>&1 "
."| findstr /V \"DTDDECL catalog entries are not supported\" "; . "| findstr /V \"DTDDECL catalog entries are not supported\" ";
system($cmd); # die "openjade" if $?; system($cmd); # die "openjade" if $?;
copy "stylesheet.css", "html/stylesheet.css"; copy "stylesheet.css", "html/stylesheet.css";
...@@ -116,6 +118,7 @@ sub missing ...@@ -116,6 +118,7 @@ sub missing
sub noversion sub noversion
{ {
print STDERR "Could not find version.sgml. ","Please run mkvcbuild.pl first!\n"; print STDERR "Could not find version.sgml. ",
"Please run mkvcbuild.pl first!\n";
exit 1; exit 1;
} }
src/tools/msvc/config_default.pl
View file @ 042d9ffc
...@@ -3,25 +3,25 @@ use strict; ...@@ -3,25 +3,25 @@ use strict;
use warnings; use warnings;
our $config = { our $config = {
asserts=>0, # --enable-cassert asserts => 0, # --enable-cassert
# integer_datetimes=>1, # --enable-integer-datetimes - on is now default # integer_datetimes=>1, # --enable-integer-datetimes - on is now default
# float4byval=>1, # --disable-float4-byval, on by default # float4byval=>1, # --disable-float4-byval, on by default
# float8byval=>0, # --disable-float8-byval, off by default # float8byval=>0, # --disable-float8-byval, off by default
# blocksize => 8, # --with-blocksize, 8kB by default # blocksize => 8, # --with-blocksize, 8kB by default
# wal_blocksize => 8, # --with-wal-blocksize, 8kB by default # wal_blocksize => 8, # --with-wal-blocksize, 8kB by default
# wal_segsize => 16, # --with-wal-segsize, 16MB by default # wal_segsize => 16, # --with-wal-segsize, 16MB by default
ldap=>1, # --with-ldap ldap => 1, # --with-ldap
nls=>undef, # --enable-nls=<path> nls => undef, # --enable-nls=<path>
tcl=>undef, # --with-tls=<path> tcl => undef, # --with-tls=<path>
perl=>undef, # --with-perl perl => undef, # --with-perl
python=>undef, # --with-python=<path> python => undef, # --with-python=<path>
krb5=>undef, # --with-krb5=<path> krb5 => undef, # --with-krb5=<path>
openssl=>undef, # --with-ssl=<path> openssl => undef, # --with-ssl=<path>
uuid=>undef, # --with-ossp-uuid uuid => undef, # --with-ossp-uuid
xml=>undef, # --with-libxml=<path> xml => undef, # --with-libxml=<path>
xslt=>undef, # --with-libxslt=<path> xslt => undef, # --with-libxslt=<path>
iconv=>undef, # (not in configure, path to iconv) iconv => undef, # (not in configure, path to iconv)
zlib=>undef # --with-zlib=<path> zlib => undef # --with-zlib=<path>
}; };
1; 1;
src/tools/msvc/gendef.pl
View file @ 042d9ffc
...@@ -7,8 +7,9 @@ my @def; ...@@ -7,8 +7,9 @@ my @def;
# #
die "Usage: gendef.pl <modulepath> <platform>\n" die "Usage: gendef.pl <modulepath> <platform>\n"
unless(($ARGV[0] =~ /\\([^\\]+$)/) && ($ARGV[1] == 'Win32' || $ARGV[1] == 'x64')); unless (($ARGV[0] =~ /\\([^\\]+$)/)
my $defname = uc $1; && ($ARGV[1] == 'Win32' || $ARGV[1] == 'x64'));
my $defname = uc $1;
my $platform = $ARGV[1]; my $platform = $ARGV[1];
if (-f "$ARGV[0]/$defname.def") if (-f "$ARGV[0]/$defname.def")
...@@ -22,9 +23,10 @@ print "Generating $defname.DEF from directory $ARGV[0], platform $platform\n"; ...@@ -22,9 +23,10 @@ print "Generating $defname.DEF from directory $ARGV[0], platform $platform\n";
while (<$ARGV[0]/*.obj>) while (<$ARGV[0]/*.obj>)
{ {
my $symfile = $_; my $symfile = $_;
$symfile=~ s/\.obj$/.sym/i; $symfile =~ s/\.obj$/.sym/i;
print "."; print ".";
system("dumpbin /symbols /out:symbols.out $_ >NUL") && die "Could not call dumpbin"; system("dumpbin /symbols /out:symbols.out $_ >NUL")
&& die "Could not call dumpbin";
open(F, "<symbols.out") || die "Could not open symbols.out for $_\n"; open(F, "<symbols.out") || die "Could not open symbols.out for $_\n";
while (<F>) while (<F>)
{ {
...@@ -46,19 +48,20 @@ while (<$ARGV[0]/*.obj>) ...@@ -46,19 +48,20 @@ while (<$ARGV[0]/*.obj>)
push @def, $pieces[6]; push @def, $pieces[6];
} }
close(F); close(F);
rename("symbols.out",$symfile); rename("symbols.out", $symfile);
} }
print "\n"; print "\n";
open(DEF,">$ARGV[0]/$defname.def") || die "Could not write to $defname\n"; open(DEF, ">$ARGV[0]/$defname.def") || die "Could not write to $defname\n";
print DEF "EXPORTS\n"; print DEF "EXPORTS\n";
my $i = 0; my $i = 0;
my $last = ""; my $last = "";
foreach my $f (sort @def) foreach my $f (sort @def)
{ {
next if ($f eq $last); next if ($f eq $last);
$last = $f; $last = $f;
$f =~ s/^_// unless ($platform eq "x64"); # win64 has new format of exports $f =~ s/^_//
unless ($platform eq "x64"); # win64 has new format of exports
$i++; $i++;
# print DEF " $f \@ $i\n"; # ordinaled exports? # print DEF " $f \@ $i\n"; # ordinaled exports?
......
src/tools/msvc/mkvcbuild.pl
View file @ 042d9ffc
...@@ -10,10 +10,13 @@ use warnings; ...@@ -10,10 +10,13 @@ use warnings;
use Mkvcbuild; use Mkvcbuild;
chdir('..\..\..') if (-d '..\msvc' && -d '..\..\..\src'); chdir('..\..\..') if (-d '..\msvc' && -d '..\..\..\src');
die 'Must run from root or msvc directory' unless (-d 'src\tools\msvc' && -d 'src'); die 'Must run from root or msvc directory'
unless (-d 'src\tools\msvc' && -d 'src');
die 'Could not find config_default.pl' unless (-f 'src/tools/msvc/config_default.pl'); die 'Could not find config_default.pl'
print "Warning: no config.pl found, using default.\n" unless (-f 'src/tools/msvc/config.pl'); unless (-f 'src/tools/msvc/config_default.pl');
print "Warning: no config.pl found, using default.\n"
unless (-f 'src/tools/msvc/config.pl');
our $config; our $config;
require 'src/tools/msvc/config_default.pl'; require 'src/tools/msvc/config_default.pl';
......
src/tools/msvc/pgbison.pl
View file @ 042d9ffc
...@@ -9,8 +9,8 @@ use File::Basename; ...@@ -9,8 +9,8 @@ use File::Basename;
require 'src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl'; require 'src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl';
my ($bisonver) = `bison -V`; # grab first line my ($bisonver) = `bison -V`; # grab first line
$bisonver=(split(/\s+/,$bisonver))[3]; # grab version number $bisonver = (split(/\s+/, $bisonver))[3]; # grab version number
unless ($bisonver eq '1.875' || $bisonver ge '2.2') unless ($bisonver eq '1.875' || $bisonver ge '2.2')
{ {
...@@ -38,9 +38,9 @@ $output =~ s/gram\.c$/pl_gram.c/ if $input =~ /src.pl.plpgsql.src.gram\.y$/; ...@@ -38,9 +38,9 @@ $output =~ s/gram\.c$/pl_gram.c/ if $input =~ /src.pl.plpgsql.src.gram\.y$/;
my $makefile = dirname($input) . "/Makefile"; my $makefile = dirname($input) . "/Makefile";
my ($mf, $make); my ($mf, $make);
open($mf,$makefile); open($mf, $makefile);
local $/ = undef; local $/ = undef;
$make=<$mf>; $make = <$mf>;
close($mf); close($mf);
my $headerflag = ($make =~ /\$\(BISON\)\s+-d/ ? '-d' : ''); my $headerflag = ($make =~ /\$\(BISON\)\s+-d/ ? '-d' : '');
......
src/tools/msvc/pgflex.pl
View file @ 042d9ffc
...@@ -12,10 +12,10 @@ use File::Basename; ...@@ -12,10 +12,10 @@ use File::Basename;
require 'src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl'; require 'src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl';
my ($flexver) = `flex -V`; # grab first line my ($flexver) = `flex -V`; # grab first line
$flexver=(split(/\s+/,$flexver))[1]; $flexver = (split(/\s+/, $flexver))[1];
$flexver =~ s/[^0-9.]//g; $flexver =~ s/[^0-9.]//g;
my @verparts = split(/\./,$flexver); my @verparts = split(/\./, $flexver);
unless ($verparts[0] == 2 && $verparts[1] == 5 && $verparts[2] >= 31) unless ($verparts[0] == 2 && $verparts[1] == 5 && $verparts[2] >= 31)
{ {
print "WARNING! Flex install not found, or unsupported Flex version.\n"; print "WARNING! Flex install not found, or unsupported Flex version.\n";
...@@ -40,9 +40,9 @@ elsif (!-e $input) ...@@ -40,9 +40,9 @@ elsif (!-e $input)
# get flex flags from make file # get flex flags from make file
my $makefile = dirname($input) . "/Makefile"; my $makefile = dirname($input) . "/Makefile";
my ($mf, $make); my ($mf, $make);
open($mf,$makefile); open($mf, $makefile);
local $/ = undef; local $/ = undef;
$make=<$mf>; $make = <$mf>;
close($mf); close($mf);
my $flexflags = ($make =~ /^\s*FLEXFLAGS\s*=\s*(\S.*)/m ? $1 : ''); my $flexflags = ($make =~ /^\s*FLEXFLAGS\s*=\s*(\S.*)/m ? $1 : '');
...@@ -55,24 +55,24 @@ if ($? == 0) ...@@ -55,24 +55,24 @@ if ($? == 0)
# For reentrant scanners (like the core scanner) we do not # For reentrant scanners (like the core scanner) we do not
# need to (and must not) change the yywrap definition. # need to (and must not) change the yywrap definition.
my $lfile; my $lfile;
open($lfile,$input) || die "opening $input for reading: $!"; open($lfile, $input) || die "opening $input for reading: $!";
my $lcode = <$lfile>; my $lcode = <$lfile>;
close($lfile); close($lfile);
if ($lcode !~ /\%option\sreentrant/) if ($lcode !~ /\%option\sreentrant/)
{ {
my $cfile; my $cfile;
open($cfile,$output) || die "opening $output for reading: $!"; open($cfile, $output) || die "opening $output for reading: $!";
my $ccode = <$cfile>; my $ccode = <$cfile>;
close($cfile); close($cfile);
$ccode =~ s/yywrap\(n\)/yywrap()/; $ccode =~ s/yywrap\(n\)/yywrap()/;
open($cfile,">$output") || die "opening $output for reading: $!"; open($cfile, ">$output") || die "opening $output for reading: $!";
print $cfile $ccode; print $cfile $ccode;
close($cfile); close($cfile);
} }
if ($flexflags =~ /\s-b\s/) if ($flexflags =~ /\s-b\s/)
{ {
my $lexback = "lex.backup"; my $lexback = "lex.backup";
open($lfile,$lexback) || die "opening $lexback for reading: $!"; open($lfile, $lexback) || die "opening $lexback for reading: $!";
my $lexbacklines = <$lfile>; my $lexbacklines = <$lfile>;
close($lfile); close($lfile);
my $linecount = $lexbacklines =~ tr /\n/\n/; my $linecount = $lexbacklines =~ tr /\n/\n/;
......
src/tools/msvc/vcregress.pl
View file @ 042d9ffc
...@@ -26,7 +26,8 @@ if (-e "src/tools/msvc/buildenv.pl") ...@@ -26,7 +26,8 @@ if (-e "src/tools/msvc/buildenv.pl")
} }
my $what = shift || ""; my $what = shift || "";
if ($what =~ /^(check|installcheck|plcheck|contribcheck|ecpgcheck|isolationcheck)$/i) if ($what =~
/^(check|installcheck|plcheck|contribcheck|ecpgcheck|isolationcheck)$/i)
{ {
$what = uc $what; $what = uc $what;
} }
...@@ -38,10 +39,10 @@ else ...@@ -38,10 +39,10 @@ else
# use a capital C here because config.pl has $config # use a capital C here because config.pl has $config
my $Config = -e "release/postgres/postgres.exe" ? "Release" : "Debug"; my $Config = -e "release/postgres/postgres.exe" ? "Release" : "Debug";
copy("$Config/refint/refint.dll","src/test/regress"); copy("$Config/refint/refint.dll", "src/test/regress");
copy("$Config/autoinc/autoinc.dll","src/test/regress"); copy("$Config/autoinc/autoinc.dll", "src/test/regress");
copy("$Config/regress/regress.dll","src/test/regress"); copy("$Config/regress/regress.dll", "src/test/regress");
copy("$Config/dummy_seclabel/dummy_seclabel.dll","src/test/regress"); copy("$Config/dummy_seclabel/dummy_seclabel.dll", "src/test/regress");
$ENV{PATH} = "../../../$Config/libpq;../../$Config/libpq;$ENV{PATH}"; $ENV{PATH} = "../../../$Config/libpq;../../$Config/libpq;$ENV{PATH}";
...@@ -67,13 +68,12 @@ $temp_config = "--temp-config=\"$ENV{TEMP_CONFIG}\"" ...@@ -67,13 +68,12 @@ $temp_config = "--temp-config=\"$ENV{TEMP_CONFIG}\""
chdir "src/test/regress"; chdir "src/test/regress";
my %command = ( my %command = (
CHECK => \&check, CHECK => \&check,
PLCHECK => \&plcheck, PLCHECK => \&plcheck,
INSTALLCHECK => \&installcheck, INSTALLCHECK => \&installcheck,
ECPGCHECK => \&ecpgcheck, ECPGCHECK => \&ecpgcheck,
CONTRIBCHECK => \&contribcheck, CONTRIBCHECK => \&contribcheck,
ISOLATIONCHECK => \&isolationcheck, ISOLATIONCHECK => \&isolationcheck,);
);
my $proc = $command{$what}; my $proc = $command{$what};
...@@ -88,28 +88,33 @@ exit 0; ...@@ -88,28 +88,33 @@ exit 0;
sub installcheck sub installcheck
{ {
my @args = ( my @args = (
"../../../$Config/pg_regress/pg_regress","--dlpath=.", "../../../$Config/pg_regress/pg_regress",
"--psqldir=../../../$Config/psql","--schedule=${schedule}_schedule", "--dlpath=.",
"--encoding=SQL_ASCII","--no-locale" "--psqldir=../../../$Config/psql",
); "--schedule=${schedule}_schedule",
push(@args,$maxconn) if $maxconn; "--encoding=SQL_ASCII",
"--no-locale");
push(@args, $maxconn) if $maxconn;
system(@args); system(@args);
my $status = $? >>8; my $status = $? >> 8;
exit $status if $status; exit $status if $status;
} }
sub check sub check
{ {
my @args = ( my @args = (
"../../../$Config/pg_regress/pg_regress","--dlpath=.", "../../../$Config/pg_regress/pg_regress",
"--psqldir=../../../$Config/psql","--schedule=${schedule}_schedule", "--dlpath=.",
"--encoding=SQL_ASCII","--no-locale", "--psqldir=../../../$Config/psql",
"--temp-install=./tmp_check","--top-builddir=\"$topdir\"" "--schedule=${schedule}_schedule",
); "--encoding=SQL_ASCII",
push(@args,$maxconn) if $maxconn; "--no-locale",
push(@args,$temp_config) if $temp_config; "--temp-install=./tmp_check",
"--top-builddir=\"$topdir\"");
push(@args, $maxconn) if $maxconn;
push(@args, $temp_config) if $temp_config;
system(@args); system(@args);
my $status = $? >>8; my $status = $? >> 8;
exit $status if $status; exit $status if $status;
} }
...@@ -117,10 +122,10 @@ sub ecpgcheck ...@@ -117,10 +122,10 @@ sub ecpgcheck
{ {
chdir $startdir; chdir $startdir;
system("msbuild ecpg_regression.proj /p:config=$Config"); system("msbuild ecpg_regression.proj /p:config=$Config");
my $status = $? >>8; my $status = $? >> 8;
exit $status if $status; exit $status if $status;
chdir "$topdir/src/interfaces/ecpg/test"; chdir "$topdir/src/interfaces/ecpg/test";
$schedule="ecpg"; $schedule = "ecpg";
my @args = ( my @args = (
"../../../../$Config/pg_regress_ecpg/pg_regress_ecpg", "../../../../$Config/pg_regress_ecpg/pg_regress_ecpg",
"--psqldir=../../../$Config/psql", "--psqldir=../../../$Config/psql",
...@@ -130,26 +135,25 @@ sub ecpgcheck ...@@ -130,26 +135,25 @@ sub ecpgcheck
"--encoding=SQL_ASCII", "--encoding=SQL_ASCII",
"--no-locale", "--no-locale",
"--temp-install=./tmp_chk", "--temp-install=./tmp_chk",
"--top-builddir=\"$topdir\"" "--top-builddir=\"$topdir\"");
); push(@args, $maxconn) if $maxconn;
push(@args,$maxconn) if $maxconn;
system(@args); system(@args);
$status = $? >>8; $status = $? >> 8;
exit $status if $status; exit $status if $status;
} }
sub isolationcheck sub isolationcheck
{ {
chdir "../isolation"; chdir "../isolation";
copy("../../../$Config/isolationtester/isolationtester.exe","."); copy("../../../$Config/isolationtester/isolationtester.exe", ".");
my @args = ( my @args = (
"../../../$Config/pg_isolation_regress/pg_isolation_regress", "../../../$Config/pg_isolation_regress/pg_isolation_regress",
"--psqldir=../../../$Config/psql", "--psqldir=../../../$Config/psql",
"--inputdir=.","--schedule=./isolation_schedule" "--inputdir=.",
); "--schedule=./isolation_schedule");
push(@args,$maxconn) if $maxconn; push(@args, $maxconn) if $maxconn;
system(@args); system(@args);
my $status = $? >>8; my $status = $? >> 8;
exit $status if $status; exit $status if $status;
} }
...@@ -178,16 +182,16 @@ sub plcheck ...@@ -178,16 +182,16 @@ sub plcheck
use Config; use Config;
if ($Config{usemultiplicity} eq 'define') if ($Config{usemultiplicity} eq 'define')
{ {
push(@tests,'plperl_plperlu'); push(@tests, 'plperl_plperlu');
} }
} }
print "============================================================\n"; print
"============================================================\n";
print "Checking $lang\n"; print "Checking $lang\n";
my @args = ( my @args = (
"../../../$Config/pg_regress/pg_regress", "../../../$Config/pg_regress/pg_regress",
"--psqldir=../../../$Config/psql", "--psqldir=../../../$Config/psql",
"--dbname=pl_regression",@lang_args,@tests "--dbname=pl_regression", @lang_args, @tests);
);
system(@args); system(@args);
my $status = $? >> 8; my $status = $? >> 8;
exit $status if $status; exit $status if $status;
...@@ -207,18 +211,18 @@ sub contribcheck ...@@ -207,18 +211,18 @@ sub contribcheck
next if ($module eq 'xml2' && !$config->{xml}); next if ($module eq 'xml2' && !$config->{xml});
next next
unless -d "$module/sql" unless -d "$module/sql"
&&-d "$module/expected" && -d "$module/expected"
&&(-f "$module/GNUmakefile" || -f "$module/Makefile"); && (-f "$module/GNUmakefile" || -f "$module/Makefile");
chdir $module; chdir $module;
print "============================================================\n"; print
"============================================================\n";
print "Checking $module\n"; print "Checking $module\n";
my @tests = fetchTests(); my @tests = fetchTests();
my @opts = fetchRegressOpts(); my @opts = fetchRegressOpts();
my @args = ( my @args = (
"../../$Config/pg_regress/pg_regress", "../../$Config/pg_regress/pg_regress",
"--psqldir=../../$Config/psql", "--psqldir=../../$Config/psql",
"--dbname=contrib_regression",@opts,@tests "--dbname=contrib_regression", @opts, @tests);
);
system(@args); system(@args);
my $status = $? >> 8; my $status = $? >> 8;
$mstat ||= $status; $mstat ||= $status;
...@@ -230,10 +234,10 @@ sub contribcheck ...@@ -230,10 +234,10 @@ sub contribcheck
sub fetchRegressOpts sub fetchRegressOpts
{ {
my $handle; my $handle;
open($handle,"<GNUmakefile") open($handle, "<GNUmakefile")
|| open($handle,"<Makefile") || open($handle, "<Makefile")
|| die "Could not open Makefile"; || die "Could not open Makefile";
local($/) = undef; local ($/) = undef;
my $m = <$handle>; my $m = <$handle>;
close($handle); close($handle);
my @opts; my @opts;
...@@ -242,7 +246,7 @@ sub fetchRegressOpts ...@@ -242,7 +246,7 @@ sub fetchRegressOpts
# ignore options that use makefile variables - can't handle those # ignore options that use makefile variables - can't handle those
# ignore anything that isn't an option staring with -- # ignore anything that isn't an option staring with --
@opts = grep { $_ !~ /\$\(/ && $_ =~ /^--/ } split(/\s+/,$1); @opts = grep { $_ !~ /\$\(/ && $_ =~ /^--/ } split(/\s+/, $1);
} }
if ($m =~ /^\s*ENCODING\s*=\s*(\S+)/m) if ($m =~ /^\s*ENCODING\s*=\s*(\S+)/m)
{ {
...@@ -259,10 +263,10 @@ sub fetchTests ...@@ -259,10 +263,10 @@ sub fetchTests
{ {
my $handle; my $handle;
open($handle,"<GNUmakefile") open($handle, "<GNUmakefile")
|| open($handle,"<Makefile") || open($handle, "<Makefile")
|| die "Could not open Makefile"; || die "Could not open Makefile";
local($/) = undef; local ($/) = undef;
my $m = <$handle>; my $m = <$handle>;
close($handle); close($handle);
my $t = ""; my $t = "";
...@@ -281,24 +285,24 @@ sub fetchTests ...@@ -281,24 +285,24 @@ sub fetchTests
my $cftests = my $cftests =
$config->{openssl} $config->{openssl}
?GetTests("OSSL_TESTS",$m) ? GetTests("OSSL_TESTS", $m)
: GetTests("INT_TESTS",$m); : GetTests("INT_TESTS", $m);
my $pgptests = my $pgptests =
$config->{zlib} $config->{zlib}
?GetTests("ZLIB_TST",$m) ? GetTests("ZLIB_TST", $m)
: GetTests("ZLIB_OFF_TST",$m); : GetTests("ZLIB_OFF_TST", $m);
$t =~ s/\$\(CF_TESTS\)/$cftests/; $t =~ s/\$\(CF_TESTS\)/$cftests/;
$t =~ s/\$\(CF_PGP_TESTS\)/$pgptests/; $t =~ s/\$\(CF_PGP_TESTS\)/$pgptests/;
} }
} }
return split(/\s+/,$t); return split(/\s+/, $t);
} }
sub GetTests sub GetTests
{ {
my $testname = shift; my $testname = shift;
my $m = shift; my $m = shift;
if ($m =~ /^$testname\s*=\s*(.*)$/gm) if ($m =~ /^$testname\s*=\s*(.*)$/gm)
{ {
return $1; return $1;
......
src/tools/version_stamp.pl
View file @ 042d9ffc
...@@ -29,31 +29,45 @@ $major2 = 3; ...@@ -29,31 +29,45 @@ $major2 = 3;
$minor = shift; $minor = shift;
defined($minor) || die "$0: missing required argument: minor-version\n"; defined($minor) || die "$0: missing required argument: minor-version\n";
if ($minor =~ m/^\d+$/) { if ($minor =~ m/^\d+$/)
$dotneeded = 1; {
$numericminor = $minor; $dotneeded = 1;
} elsif ($minor eq "devel") { $numericminor = $minor;
$dotneeded = 0; }
$numericminor = 0; elsif ($minor eq "devel")
} elsif ($minor =~ m/^alpha\d+$/) { {
$dotneeded = 0; $dotneeded = 0;
$numericminor = 0; $numericminor = 0;
} elsif ($minor =~ m/^beta\d+$/) { }
$dotneeded = 0; elsif ($minor =~ m/^alpha\d+$/)
$numericminor = 0; {
} elsif ($minor =~ m/^rc\d+$/) { $dotneeded = 0;
$dotneeded = 0; $numericminor = 0;
$numericminor = 0; }
} else { elsif ($minor =~ m/^beta\d+$/)
die "$0: minor-version must be N, devel, alphaN, betaN, or rcN\n"; {
$dotneeded = 0;
$numericminor = 0;
}
elsif ($minor =~ m/^rc\d+$/)
{
$dotneeded = 0;
$numericminor = 0;
}
else
{
die "$0: minor-version must be N, devel, alphaN, betaN, or rcN\n";
} }
# Create various required forms of the version number # Create various required forms of the version number
$majorversion = $major1 . "." . $major2; $majorversion = $major1 . "." . $major2;
if ($dotneeded) { if ($dotneeded)
$fullversion = $majorversion . "." . $minor; {
} else { $fullversion = $majorversion . "." . $minor;
$fullversion = $majorversion . $minor; }
else
{
$fullversion = $majorversion . $minor;
} }
$numericversion = $majorversion . "." . $numericminor; $numericversion = $majorversion . "." . $numericminor;
$padnumericversion = sprintf("%d%02d%02d", $major1, $major2, $numericminor); $padnumericversion = sprintf("%d%02d%02d", $major1, $major2, $numericminor);
...@@ -63,54 +77,64 @@ $padnumericversion = sprintf("%d%02d%02d", $major1, $major2, $numericminor); ...@@ -63,54 +77,64 @@ $padnumericversion = sprintf("%d%02d%02d", $major1, $major2, $numericminor);
$aconfver = ""; $aconfver = "";
open(FILE, "configure.in") || die "could not read configure.in: $!\n"; open(FILE, "configure.in") || die "could not read configure.in: $!\n";
while (<FILE>) { while (<FILE>)
if (m/^m4_if\(m4_defn\(\[m4_PACKAGE_VERSION\]\), \[(.*)\], \[\], \[m4_fatal/) { {
$aconfver = $1; if (
last; m/^m4_if\(m4_defn\(\[m4_PACKAGE_VERSION\]\), \[(.*)\], \[\], \[m4_fatal/)
} {
$aconfver = $1;
last;
}
} }
close(FILE); close(FILE);
$aconfver ne "" || die "could not find autoconf version number in configure.in\n"; $aconfver ne ""
|| die "could not find autoconf version number in configure.in\n";
# Update configure.in and other files that contain version numbers # Update configure.in and other files that contain version numbers
$fixedfiles = ""; $fixedfiles = "";
sed_file("configure.in", sed_file("configure.in",
"-e 's/AC_INIT(\\[PostgreSQL\\], \\[[0-9a-z.]*\\]/AC_INIT([PostgreSQL], [$fullversion]/'"); "-e 's/AC_INIT(\\[PostgreSQL\\], \\[[0-9a-z.]*\\]/AC_INIT([PostgreSQL], [$fullversion]/'"
);
sed_file("doc/bug.template", sed_file("doc/bug.template",
"-e 's/PostgreSQL version (example: PostgreSQL .*) *: PostgreSQL .*/PostgreSQL version (example: PostgreSQL $fullversion): PostgreSQL $fullversion/'"); "-e 's/PostgreSQL version (example: PostgreSQL .*) *: PostgreSQL .*/PostgreSQL version (example: PostgreSQL $fullversion): PostgreSQL $fullversion/'"
);
sed_file("src/include/pg_config.h.win32", sed_file("src/include/pg_config.h.win32",
"-e 's/#define PACKAGE_STRING \"PostgreSQL .*\"/#define PACKAGE_STRING \"PostgreSQL $fullversion\"/' " . "-e 's/#define PACKAGE_STRING \"PostgreSQL .*\"/#define PACKAGE_STRING \"PostgreSQL $fullversion\"/' "
"-e 's/#define PACKAGE_VERSION \".*\"/#define PACKAGE_VERSION \"$fullversion\"/' " . . "-e 's/#define PACKAGE_VERSION \".*\"/#define PACKAGE_VERSION \"$fullversion\"/' "
"-e 's/#define PG_VERSION \".*\"/#define PG_VERSION \"$fullversion\"/' " . . "-e 's/#define PG_VERSION \".*\"/#define PG_VERSION \"$fullversion\"/' "
"-e 's/#define PG_VERSION_NUM .*/#define PG_VERSION_NUM $padnumericversion/'"); . "-e 's/#define PG_VERSION_NUM .*/#define PG_VERSION_NUM $padnumericversion/'"
);
sed_file("src/interfaces/libpq/libpq.rc.in", sed_file("src/interfaces/libpq/libpq.rc.in",
"-e 's/FILEVERSION [0-9]*,[0-9]*,[0-9]*,0/FILEVERSION $major1,$major2,$numericminor,0/' " . "-e 's/FILEVERSION [0-9]*,[0-9]*,[0-9]*,0/FILEVERSION $major1,$major2,$numericminor,0/' "
"-e 's/PRODUCTVERSION [0-9]*,[0-9]*,[0-9]*,0/PRODUCTVERSION $major1,$major2,$numericminor,0/' " . . "-e 's/PRODUCTVERSION [0-9]*,[0-9]*,[0-9]*,0/PRODUCTVERSION $major1,$major2,$numericminor,0/' "
"-e 's/VALUE \"FileVersion\", \"[0-9.]*/VALUE \"FileVersion\", \"$numericversion/' " . . "-e 's/VALUE \"FileVersion\", \"[0-9.]*/VALUE \"FileVersion\", \"$numericversion/' "
"-e 's/VALUE \"ProductVersion\", \"[0-9.]*/VALUE \"ProductVersion\", \"$numericversion/'"); . "-e 's/VALUE \"ProductVersion\", \"[0-9.]*/VALUE \"ProductVersion\", \"$numericversion/'"
);
sed_file("src/port/win32ver.rc", sed_file("src/port/win32ver.rc",
"-e 's/FILEVERSION [0-9]*,[0-9]*,[0-9]*,0/FILEVERSION $major1,$major2,$numericminor,0/' " . "-e 's/FILEVERSION [0-9]*,[0-9]*,[0-9]*,0/FILEVERSION $major1,$major2,$numericminor,0/' "
"-e 's/PRODUCTVERSION [0-9]*,[0-9]*,[0-9]*,0/PRODUCTVERSION $major1,$major2,$numericminor,0/'"); . "-e 's/PRODUCTVERSION [0-9]*,[0-9]*,[0-9]*,0/PRODUCTVERSION $major1,$major2,$numericminor,0/'"
);
print "Stamped these files with version number $fullversion:\n$fixedfiles"; print "Stamped these files with version number $fullversion:\n$fixedfiles";
print "Don't forget to run autoconf $aconfver before committing.\n"; print "Don't forget to run autoconf $aconfver before committing.\n";
exit 0; exit 0;
sub sed_file { sub sed_file
my($filename, $sedargs) = @_; {
my($tmpfilename) = $filename . ".tmp"; my ($filename, $sedargs) = @_;
my ($tmpfilename) = $filename . ".tmp";
system("sed $sedargs $filename >$tmpfilename") == 0 system("sed $sedargs $filename >$tmpfilename") == 0
or die "sed failed: $?"; or die "sed failed: $?";
system("mv $tmpfilename $filename") == 0 system("mv $tmpfilename $filename") == 0
or die "mv failed: $?"; or die "mv failed: $?";
$fixedfiles .= "\t$filename\n"; $fixedfiles .= "\t$filename\n";
} }
src/tools/win32tzlist.pl
View file @ 042d9ffc
...@@ -26,7 +26,8 @@ my $tzfile = 'src/bin/initdb/findtimezone.c'; ...@@ -26,7 +26,8 @@ my $tzfile = 'src/bin/initdb/findtimezone.c';
# Fetch all timezones in the registry # Fetch all timezones in the registry
# #
my $basekey; my $basekey;
$HKEY_LOCAL_MACHINE->Open("SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Time Zones", $basekey) $HKEY_LOCAL_MACHINE->Open(
"SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Time Zones", $basekey)
or die $!; or die $!;
my @subkeys; my @subkeys;
...@@ -36,21 +37,19 @@ my @system_zones; ...@@ -36,21 +37,19 @@ my @system_zones;
foreach my $keyname (@subkeys) foreach my $keyname (@subkeys)
{ {
my $subkey; my $subkey;
my %vals; my %vals;
$basekey->Open($keyname, $subkey) or die $!; $basekey->Open($keyname, $subkey) or die $!;
$subkey->GetValues(\%vals) or die $!; $subkey->GetValues(\%vals) or die $!;
$subkey->Close(); $subkey->Close();
die "Incomplete timezone data for $keyname!\n" die "Incomplete timezone data for $keyname!\n"
unless ($vals{Std} && $vals{Dlt} && $vals{Display}); unless ($vals{Std} && $vals{Dlt} && $vals{Display});
push @system_zones, push @system_zones,
{ { 'std' => $vals{Std}->[2],
'std'=>$vals{Std}->[2], 'dlt' => $vals{Dlt}->[2],
'dlt'=>$vals{Dlt}->[2], 'display' => clean_displayname($vals{Display}->[2]), };
'display'=>clean_displayname($vals{Display}->[2]),
};
} }
$basekey->Close(); $basekey->Close();
...@@ -59,7 +58,7 @@ $basekey->Close(); ...@@ -59,7 +58,7 @@ $basekey->Close();
# Fetch all timezones currently in the file # Fetch all timezones currently in the file
# #
my @file_zones; my @file_zones;
open(TZFILE,"<$tzfile") or die "Could not open $tzfile!\n"; open(TZFILE, "<$tzfile") or die "Could not open $tzfile!\n";
my $t = $/; my $t = $/;
undef $/; undef $/;
my $pgtz = <TZFILE>; my $pgtz = <TZFILE>;
...@@ -72,15 +71,14 @@ $pgtz =~ /win32_tzmap\[\] =\s+{\s+\/\*[^\/]+\*\/\s+(.+?)};/gs ...@@ -72,15 +71,14 @@ $pgtz =~ /win32_tzmap\[\] =\s+{\s+\/\*[^\/]+\*\/\s+(.+?)};/gs
$pgtz = $1; $pgtz = $1;
# Extract each individual record from the struct # Extract each individual record from the struct
while ($pgtz =~ m/{\s+"([^"]+)",\s+"([^"]+)",\s+"([^"]+)",?\s+},\s+\/\*(.+?)\*\//gs) while ($pgtz =~
m/{\s+"([^"]+)",\s+"([^"]+)",\s+"([^"]+)",?\s+},\s+\/\*(.+?)\*\//gs)
{ {
push @file_zones, push @file_zones,
{ { 'std' => $1,
'std'=>$1, 'dlt' => $2,
'dlt'=>$2, 'match' => $3,
'match'=>$3, 'display' => clean_displayname($4), };
'display'=>clean_displayname($4),
};
} }
# #
...@@ -90,47 +88,48 @@ my @add; ...@@ -90,47 +88,48 @@ my @add;
for my $sys (@system_zones) for my $sys (@system_zones)
{ {
my $match = 0; my $match = 0;
for my $file (@file_zones) for my $file (@file_zones)
{ {
if ($sys->{std} eq $file->{std}) if ($sys->{std} eq $file->{std})
{ {
$match=1; $match = 1;
if ($sys->{dlt} ne $file->{dlt}) if ($sys->{dlt} ne $file->{dlt})
{ {
print "Timezone $sys->{std}, changed name of daylight zone!\n"; print
} "Timezone $sys->{std}, changed name of daylight zone!\n";
if ($sys->{display} ne $file->{display}) }
{ if ($sys->{display} ne $file->{display})
print {
print
"Timezone $sys->{std} changed displayname ('$sys->{display}' from '$file->{display}')!\n"; "Timezone $sys->{std} changed displayname ('$sys->{display}' from '$file->{display}')!\n";
} }
last; last;
} }
} }
unless ($match) unless ($match)
{ {
push @add, $sys; push @add, $sys;
} }
} }
if (@add) if (@add)
{ {
print "\n\nOther than that, add the following timezones:\n"; print "\n\nOther than that, add the following timezones:\n";
for my $z (@add) for my $z (@add)
{ {
print print
"\t{\n\t\t\"$z->{std}\", \"$z->{dlt}\",\n\t\t\"FIXME\"\n\t},\t\t\t\t\t\t\t/* $z->{display} */\n"; "\t{\n\t\t\"$z->{std}\", \"$z->{dlt}\",\n\t\t\"FIXME\"\n\t},\t\t\t\t\t\t\t/* $z->{display} */\n";
} }
} }
sub clean_displayname sub clean_displayname
{ {
my $dn = shift; my $dn = shift;
$dn =~ s/\s+/ /gs; $dn =~ s/\s+/ /gs;
$dn =~ s/\*//gs; $dn =~ s/\*//gs;
$dn =~ s/^\s+//gs; $dn =~ s/^\s+//gs;
$dn =~ s/\s+$//gs; $dn =~ s/\s+$//gs;
return $dn; return $dn;
} }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment