database/postgres
1
0
Fork 0
mirror of https://github.com/postgres/postgres.git synced 2025-06-10 09:21:54 +03:00
Code Activity

Run newly-configured perltidy script on Perl files.

Browse Source 
Run on HEAD and 9.2.
This commit is contained in:
Bruce Momjian
2012-07-04 21:47:48 -04:00
parent 9c6f8be2b1
commit 2bc09ff499
53 changed files with 3249 additions and 2590 deletions
Download Patch File Download Diff File Expand all files Collapse all files

70
contrib/intarray/bench/bench.pl
View File

@ -1,6 +1,7 @@
#!/usr/bin/perl
use strict;
# make sure we are in a sane environment.
use DBI();
use DBD::Pg();
@ -10,7 +11,8 @@ use Getopt::Std;
my %opt;
getopts('d:b:s:veorauc', \%opt);
if ( !( scalar %opt && defined $opt{s} ) ) {
if (!(scalar %opt && defined $opt{s}))
{
print <<EOT;
Usage:
$0 -d DATABASE -s SECTIONS [-b NUMBER] [-v] [-e] [-o] [-r] [-a] [-u]
@ -37,20 +39,30 @@ my @where;
$table{message} = 1;
if ( $opt{a} ) {
if ( $opt{r} ) {
if ($opt{a})
{
if ($opt{r})
{
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, "msp$sid.sid = $sid";
$table{"message_section_map msp$sid"} = 1;
}
}
} else {
if ( $opt{r} ) {
}
else
{
if ($opt{r})
{
push @where, "message.sections && '{$opt{s}}'";
} else {
}
else
{
$table{message_section_map} = 1;
push @where, "message.mid = message_section_map.mid";
push @where, "message_section_map.sid in ($opt{s})";
@ -58,18 +70,28 @@ if ( $opt{a} ) {
}
my $outf;
if ( $opt{c} ) {
$outf = ( $opt{u} ) ? 'count( distinct message.mid )' : 'count( message.mid )';
} else {
if ($opt{c})
{
$outf =
($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";
}
if ( $opt{e} ) {
if ($opt{e})
{
$dbi->do("explain $sql");
}
@ -78,26 +100,34 @@ my $count=0;
my $b = $opt{b};
$b ||= 1;
my @a;
foreach ( 1..$b ) {
foreach (1 .. $b)
{
@a = exec_sql($dbi, $sql);
$count = $#a;
}
my $elapsed = tv_interval($t0, [gettimeofday]);
if ( $opt{o} ) {
foreach ( @a ) {
if ($opt{o})
{
foreach (@a)
{
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(
"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;
$sth->execute(@keys) || die;
my $r;
my @row;
while ( defined ( $r=$sth->fetchrow_hashref ) ) {
while (defined($r = $sth->fetchrow_hashref))
{
push @row, $r;
}
$sth->finish;

27
contrib/intarray/bench/create_test.pl
View File

@ -19,23 +19,33 @@ open(MSG,">message.tmp") || die;
open(MAP, ">message_section_map.tmp") || die;
srand(1);
#foreach my $i ( 1..1778 ) {
#foreach my $i ( 1..3443 ) {
#foreach my $i ( 1..5000 ) {
#foreach my $i ( 1..29362 ) {
#foreach my $i ( 1..33331 ) {
#foreach my $i ( 1..83268 ) {
foreach my $i ( 1..200000 ) {
foreach my $i (1 .. 200000)
{
my @sect;
if ( rand() < 0.7 ) {
if (rand() < 0.7)
{
$sect[0] = int((rand()**4) * 100);
} else {
my %hash;
@sect = grep { $hash{$_}++; $hash{$_} <= 1 } map { int( (rand()**4)*100) } 0..( int(rand()*5) );
}
if ( $#sect < 0 || rand() < 0.1 ) {
else
{
my %hash;
@sect =
grep { $hash{$_}++; $hash{$_} <= 1 }
map { int((rand()**4) * 100) } 0 .. (int(rand() * 5));
}
if ($#sect < 0 || rand() < 0.1)
{
print MSG "$i\t\\N\n";
} else {
}
else
{
print MSG "$i\t{" . join(',', @sect) . "}\n";
map { print MAP "$i\t$_\n" } @sect;
}
@ -64,7 +74,8 @@ EOT
unlink 'message.tmp', 'message_section_map.tmp';
sub copytable {
sub copytable
{
my $t = shift;
print "COPY $t from stdin;\n";

22
contrib/seg/seg-validate.pl
View File

@ -18,24 +18,32 @@ $rule_5 = $boundary;
print "$rule_5\n";
while (<>) {
while (<>)
{
# s/ +//g;
if ( /^($rule_1)$/ ) {
if (/^($rule_1)$/)
{
print;
}
elsif ( /^($rule_2)$/ ) {
elsif (/^($rule_2)$/)
{
print;
}
elsif ( /^($rule_3)$/ ) {
elsif (/^($rule_3)$/)
{
print;
}
elsif ( /^($rule_4)$/ ) {
elsif (/^($rule_4)$/)
{
print;
}
elsif ( /^($rule_5)$/ ) {
elsif (/^($rule_5)$/)
{
print;
}
else {
else
{
print STDERR "error in $_\n";
}

11
contrib/seg/sort-segments.pl
View File

@ -2,12 +2,14 @@
# this script will sort any table with the segment data type in its last column
while (<>) {
while (<>)
{
chomp;
push @rows, $_;
}
foreach ( sort {
foreach (
sort {
@ar = split("\t", $a);
$valA = pop @ar;
$valA =~ s/[~<> ]+//g;
@ -15,6 +17,7 @@ foreach ( sort {
$valB = pop @ar;
$valB =~ s/[~<> ]+//g;
$valA <=> $valB
} @rows ) {
print "$_\n";;
} @rows)
{
print "$_\n";
}

17
doc/src/sgml/generate-errcodes-table.pl
View File

@ -6,11 +6,13 @@
use warnings;
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;
while (<$errcodes>) {
while (<$errcodes>)
{
chomp;
# Skip comments
@ -18,12 +20,15 @@ while (<$errcodes>) {
next if /^\s*$/;
# Emit section headers
if (/^Section:/) {
if (/^Section:/)
{
# Remove the Section: string
s/^Section: //;
# Escape dashes for SGML
s/-/&mdash;/;
# Wrap PostgreSQL in <productname/>
s/PostgreSQL/<productname>PostgreSQL<\/>/g;
@ -38,10 +43,8 @@ while (<$errcodes>) {
die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/;
(my $sqlstate,
my $type,
my $errcode_macro,
my $condition_name) = ($1, $2, $3, $4);
(my $sqlstate, my $type, my $errcode_macro, my $condition_name) =
($1, $2, $3, $4);
# Skip lines without PL/pgSQL condition names
next unless defined($condition_name);

17
doc/src/sgml/generate_history.pl
View File

@ -25,7 +25,8 @@ process_file($infile);
exit 0;
sub process_file {
sub process_file
{
my $filename = shift;
local *FILE; # need a local filehandle so we can recurse
@ -33,18 +34,24 @@ sub process_file {
my $f = $srcdir . '/' . $filename;
open(FILE, $f) || die "could not read $f: $!\n";
while (<FILE>) {
while (<FILE>)
{
# Recursively expand sub-files of the release notes
if (m/^&(release-.*);$/) {
if (m/^&(release-.*);$/)
{
process_file($1 . ".sgml");
next;
}
# Remove <link ...> tags, which might span multiple lines
while (m/<link/) {
if (s/<link\s+linkend[^>]*>//) {
while (m/<link/)
{
if (s/<link\s+linkend[^>]*>//)
{
next;
}
# incomplete tag, so slurp another line
$_ .= <FILE>;
}

30
doc/src/sgml/mk_feature_tables.pl
View File

@ -8,12 +8,16 @@ open PACK, $ARGV[1] or die;
my %feature_packages;
while (<PACK>) {
while (<PACK>)
{
chomp;
my ($fid, $pname) = split /\t/;
if ($feature_packages{$fid}) {
if ($feature_packages{$fid})
{
$feature_packages{$fid} .= ", $pname";
} else {
}
else
{
$feature_packages{$fid} = $pname;
}
}
@ -24,9 +28,11 @@ open FEAT, $ARGV[2] or die;
print "<tbody>\n";
while (<FEAT>) {
while (<FEAT>)
{
chomp;
my ($feature_id, $feature_name, $subfeature_id, $subfeature_name, $is_supported, $comments) = split /\t/;
my ($feature_id, $feature_name, $subfeature_id,
$subfeature_name, $is_supported, $comments) = split /\t/;
$is_supported eq $yesno || next;
@ -37,15 +43,21 @@ while (<FEAT>) {
print " <row>\n";
if ($subfeature_id) {
if ($subfeature_id)
{
print " <entry>$feature_id-$subfeature_id</entry>\n";
} else {
}
else
{
print " <entry>$feature_id</entry>\n";
}
print " <entry>" . $feature_packages{$feature_id} . "</entry>\n";
if ($subfeature_id) {
if ($subfeature_id)
{
print " <entry>$subfeature_name</entry>\n";
} else {
}
else
{
print " <entry>$feature_name</entry>\n";
}
print " <entry>$comments</entry>\n";

28
src/backend/catalog/Catalog.pm
View File

@ -33,8 +33,7 @@ sub Catalogs
my %RENAME_ATTTYPE = (
'Oid' => 'oid',
'NameData' => 'name',
'TransactionId' => 'xid'
);
'TransactionId' => 'xid');
foreach my $input_file (@_)
{
@ -47,10 +46,12 @@ sub Catalogs
# Scan the input file.
while (<INPUT_FILE>)
{
# Strip C-style comments.
s;/\*(.|\n)*\*/;;g;
if (m;/\*;)
{
# handle multi-line comments properly.
my $next_line = <INPUT_FILE>;
die "$input_file: ends within C-style comment\n"
@ -73,6 +74,7 @@ sub Catalogs
elsif (/^DESCR\(\"(.*)\"\)$/)
{
$most_recent = $catalog{data}->[-1];
# this tests if most recent line is not a DATA() statement
if (ref $most_recent ne 'HASH')
{
@ -90,10 +92,12 @@ sub Catalogs
elsif (/^SHDESCR\(\"(.*)\"\)$/)
{
$most_recent = $catalog{data}->[-1];
# this tests if most recent line is not a DATA() statement
if (ref $most_recent ne 'HASH')
{
die "SHDESCR() does not apply to any catalog ($input_file)";
die
"SHDESCR() does not apply to any catalog ($input_file)";
}
if (!defined $most_recent->{oid})
{
@ -108,18 +112,19 @@ sub Catalogs
{
$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";
push @{ $catalog{data} },
"declare toast $toast_oid $index_oid on $toast_name\n";
}
elsif (/^DECLARE_(UNIQUE_)?INDEX\(\s*(\w+),\s*(\d+),\s*(.+)\)/)
{
$catname = 'indexing';
my ($is_unique, $index_name, $index_oid, $using) = ($1, $2, $3, $4);
my ($is_unique, $index_name, $index_oid, $using) =
($1, $2, $3, $4);
push @{ $catalog{data} },
sprintf(
"declare %sindex %s %s %s\n",
$is_unique ? 'unique ' : '',
$index_name, $index_oid, $using
);
$index_name, $index_oid, $using);
}
elsif (/^BUILD_INDICES/)
{
@ -134,9 +139,12 @@ sub Catalogs
push @{ $catalogs{names} }, $catname;
$catalog{bootstrap} = /BKI_BOOTSTRAP/ ? ' bootstrap' : '';
$catalog{shared_relation} = /BKI_SHARED_RELATION/ ? ' shared_relation' : '';
$catalog{without_oids} = /BKI_WITHOUT_OIDS/ ? ' without_oids' : '';
$catalog{rowtype_oid} = /BKI_ROWTYPE_OID\((\d+)\)/ ? " rowtype_oid $1" : '';
$catalog{shared_relation} =
/BKI_SHARED_RELATION/ ? ' shared_relation' : '';
$catalog{without_oids} =
/BKI_WITHOUT_OIDS/ ? ' without_oids' : '';
$catalog{rowtype_oid} =
/BKI_ROWTYPE_OID\((\d+)\)/ ? " rowtype_oid $1" : '';
$catalog{schema_macro} = /BKI_SCHEMA_MACRO/ ? 'True' : '';
$declaring_attributes = 1;
}

42
src/backend/catalog/genbki.pl
View File

@ -86,8 +86,10 @@ open SHDESCR, '>', $shdescrfile . $tmpext
# 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
# file's dependencies by src/backend/catalog/Makefile.
my $BOOTSTRAP_SUPERUSERID = find_defined_symbol('pg_authid.h', 'BOOTSTRAP_SUPERUSERID');
my $PG_CATALOG_NAMESPACE = find_defined_symbol('pg_namespace.h', 'PG_CATALOG_NAMESPACE');
my $BOOTSTRAP_SUPERUSERID =
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
my $catalogs = Catalog::Catalogs(@input_files);
@ -105,6 +107,7 @@ our @types;
# produce output, one catalog at a time
foreach my $catname (@{ $catalogs->{names} })
{
# .bki CREATE command for this catalog
my $catalog = $catalogs->{$catname};
print BKI "create $catname $catalog->{relation_oid}"
@ -133,9 +136,11 @@ foreach my $catname ( @{ $catalogs->{names} } )
if (defined $catalog->{data})
{
# Ordinary catalog with DATA line(s)
foreach my $row (@{ $catalog->{data} })
{
# substitute constant values we acquired above
$row->{bki_values} =~ s/\bPGUID\b/$BOOTSTRAP_SUPERUSERID/g;
$row->{bki_values} =~ s/\bPGNSP\b/$PG_CATALOG_NAMESPACE/g;
@ -156,16 +161,19 @@ foreach my $catname ( @{ $catalogs->{names} } )
# Write comments to postgres.description and postgres.shdescription
if (defined $row->{descr})
{
printf DESCR "%s\t%s\t0\t%s\n", $row->{oid}, $catname, $row->{descr};
printf DESCR "%s\t%s\t0\t%s\n", $row->{oid}, $catname,
$row->{descr};
}
if (defined $row->{shdescr})
{
printf SHDESCR "%s\t%s\t%s\n", $row->{oid}, $catname, $row->{shdescr};
printf SHDESCR "%s\t%s\t%s\n", $row->{oid}, $catname,
$row->{shdescr};
}
}
}
if ($catname eq 'pg_attribute')
{
# 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.
@ -200,9 +208,12 @@ foreach my $catname ( @{ $catalogs->{names} } )
}
# Store schemapg entries for later.
$row = emit_schemapg_row($row, grep { $bki_attr{$_} eq 'bool' } @attnames);
push @{ $schemapg_entries{$table_name} },
'{ ' . join(', ', grep { defined $_ }
$row =
emit_schemapg_row($row,
grep { $bki_attr{$_} eq 'bool' } @attnames);
push @{ $schemapg_entries{$table_name} }, '{ '
. join(
', ', grep { defined $_ }
map $row->{$_}, @attnames) . ' }';
}
@ -218,8 +229,7 @@ foreach my $catname ( @{ $catalogs->{names} } )
{ cmin => 'cid' },
{ xmax => 'xid' },
{ cmax => 'cid' },
{tableoid => 'oid'}
);
{ tableoid => 'oid' });
foreach my $attr (@SYS_ATTRS)
{
$attnum--;
@ -228,8 +238,9 @@ foreach my $catname ( @{ $catalogs->{names} } )
$row->{attstattarget} = '0';
# some catalogs don't have oids
next if $table->{without_oids} eq ' without_oids' &&
$row->{attname} eq 'oid';
next
if $table->{without_oids} eq ' without_oids'
&& $row->{attname} eq 'oid';
bki_insert($row, @attnames);
}
@ -338,9 +349,11 @@ sub emit_pgattr_row
$row{attbyval} = $type->{typbyval};
$row{attstorage} = $type->{typstorage};
$row{attalign} = $type->{typalign};
# set attndims if it's an array type
$row{attndims} = $type->{typcategory} eq 'A' ? '1' : '0';
$row{attcollation} = $type->{typcollation};
# attnotnull must be set true if the type is fixed-width and
# prior columns are too --- compare DefineAttr in bootstrap.c.
# oidvector and int2vector are also treated as not-nullable.
@ -350,7 +363,8 @@ sub emit_pgattr_row
$type->{typname} eq 'oidvector' ? 't'
: $type->{typname} eq 'int2vector' ? 't'
: $type->{typlen} eq 'NAMEDATALEN' ? 't'
: $type->{typlen} > 0 ? 't' : 'f';
: $type->{typlen} > 0 ? 't'
: 'f';
}
else
{
@ -370,8 +384,7 @@ sub emit_pgattr_row
attinhcount => '0',
attacl => '_null_',
attoptions => '_null_',
attfdwoptions => '_null_'
);
attfdwoptions => '_null_');
return { %PGATTR_DEFAULTS, %row };
}
@ -421,6 +434,7 @@ sub find_defined_symbol
my ($catalog_header, $symbol) = @_;
for my $path (@include_path)
{
# Make sure include path ends in a slash.
if (substr($path, -1) ne '/')
{

7
src/backend/utils/Gen_fmgrtab.pl
View File

@ -58,6 +58,7 @@ foreach my $column ( @{ $catalogs->{pg_proc}->{columns} } )
my $data = $catalogs->{pg_proc}->{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
# won't work, because some quoted fields might contain internal
@ -73,13 +74,11 @@ foreach my $row (@$data)
next if $row->{prolang} ne '12';
push @fmgr,
{
oid => $row->{oid},
{ oid => $row->{oid},
strict => $row->{proisstrict},
retset => $row->{proretset},
nargs => $row->{pronargs},
prosrc => $row->{prosrc},
};
prosrc => $row->{prosrc}, };
# Hack to work around memory leak in some versions of Perl
$row = undef;

13
src/backend/utils/generate-errcodes.pl
View File

@ -6,12 +6,14 @@
use warnings;
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";
open my $errcodes, $ARGV[0] or die;
while (<$errcodes>) {
while (<$errcodes>)
{
chomp;
# Skip comments
@ -19,19 +21,22 @@ while (<$errcodes>) {
next if /^\s*$/;
# Emit a comment for each section header
if (/^Section:(.*)/) {
if (/^Section:(.*)/)
{
my $header = $1;
$header =~ s/^\s+//;
print "\n/* $header */\n";
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);
# Split the sqlstate letters
$sqlstate = join ",", split "", $sqlstate;
# And quote them
$sqlstate =~ s/([^,])/'$1'/g;

76
src/backend/utils/mb/Unicode/UCS_to_BIG5.pl
View File

@ -37,17 +37,21 @@ open( FILE, $in_file ) || die( "cannot open $in_file" );
reset 'array';
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($c, $u, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){
if ($array{$utf} ne "")
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
}
@ -61,9 +65,11 @@ $in_file = "CP950.TXT";
open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($c, $u, $rest) = split;
@ -72,10 +78,14 @@ while( <FILE> ){
# Pick only the ETEN extended characters in the range 0xf9d6 - 0xf9dc
# from CP950.TXT
if( $code >= 0x80 && $ucs >= 0x0080 &&
$code >= 0xf9d6 && $code <= 0xf9dc ){
if ( $code >= 0x80
&& $ucs >= 0x0080
&& $code >= 0xf9d6
&& $code <= 0xf9dc)
{
$utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){
if ($array{$utf} ne "")
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
}
@ -89,12 +99,16 @@ $file = lc("utf8_to_big5.map");
open(FILE, "> $file") || die("cannot open $file");
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};
$count--;
if( $count == 0 ){
if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
} else {
}
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
}
}
@ -111,17 +125,21 @@ open( FILE, $in_file ) || die( "cannot open $in_file" );
reset 'array';
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($c, $u, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){
if ($array{$utf} ne "")
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
}
@ -135,9 +153,11 @@ $in_file = "CP950.TXT";
open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($c, $u, $rest) = split;
@ -146,10 +166,14 @@ while( <FILE> ){
# Pick only the ETEN extended characters in the range 0xf9d6 - 0xf9dc
# from CP950.TXT
if( $code >= 0x80 && $ucs >= 0x0080 &&
$code >= 0xf9d6 && $code <= 0xf9dc ){
if ( $code >= 0x80
&& $ucs >= 0x0080
&& $code >= 0xf9d6
&& $code <= 0xf9dc)
{
$utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){
if ($array{$utf} ne "")
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
}
@ -162,12 +186,16 @@ close( FILE );
$file = lc("big5_to_utf8.map");
open(FILE, "> $file") || die("cannot open $file");
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};
$count--;
if( $count == 0 ){
if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
} else {
}
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
}
}

44
src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl
View File

@ -24,17 +24,21 @@ $in_file = "GB2312.TXT";
open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($c, $u, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){
if ($array{$utf} ne "")
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
}
@ -53,12 +57,16 @@ $file = "utf8_to_euc_cn.map";
open(FILE, "> $file") || die("cannot open $file");
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};
$count--;
if( $count == 0 ){
if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
} else {
}
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
}
}
@ -73,17 +81,21 @@ reset 'array';
open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($c, $u, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){
if ($array{$code} ne "")
{
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next;
}
@ -98,12 +110,16 @@ close( FILE );
$file = "euc_cn_to_utf8.map";
open(FILE, "> $file") || die("cannot open $file");
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};
$count--;
if( $count == 0 ){
if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
} else {
}
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
}
}

161
src/backend/utils/mb/Unicode/UCS_to_EUC_JIS_2004.pl
View File

@ -22,8 +22,10 @@ reset 'array1';
reset 'comment';
reset 'comment1';
while($line = <FILE> ){
if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/) {
while ($line = <FILE>)
{
if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/)
{
$c = $1;
$u1 = $2;
$u2 = $3;
@ -38,18 +40,23 @@ while($line = <FILE> ){
$comment1{$str} = $rest;
$count1++;
next;
} elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/) {
}
elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/)
{
$c = $1;
$u = $2;
$rest = "U+" . $u . $3;
} else {
}
else
{
next;
}
$ucs = hex($u);
$code = hex($c);
$utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){
if ($array{$utf} ne "")
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
}
@ -67,37 +74,51 @@ print FILE " * This file was generated by UCS_to_EUC_JIS_2004.pl\n";
print FILE " */\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};
$count--;
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, $comment{ $code };
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,
$comment{$code};
}
}
print FILE "};\n";
close(FILE);
if ($TEST == 1) {
if ($TEST == 1)
{
$file1 = "utf8.data";
$file2 = "euc_jis_2004.data";
open(FILE1, "> $file1") || die("cannot open $file1");
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 != 0x5c &&
($code < 0x80 ||
($code >= 0x8ea1 && $code <= 0x8efe) ||
($code >= 0x8fa1a1 && $code <= 0x8ffefe) ||
($code >= 0xa1a1 && $code <= 0x8fefe))) {
for ($i = 3; $i >= 0; $i--) {
if ( $code > 0x00
&& $code != 0x09
&& $code != 0x0a
&& $code != 0x0d
&& $code != 0x5c
&& ( $code < 0x80
|| ($code >= 0x8ea1 && $code <= 0x8efe)
|| ($code >= 0x8fa1a1 && $code <= 0x8ffefe)
|| ($code >= 0xa1a1 && $code <= 0x8fefe)))
{
for ($i = 3; $i >= 0; $i--)
{
$s = $i * 8;
$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 FILE1 "\n";
@ -111,41 +132,57 @@ open( FILE, "> $file" ) || die( "cannot open $file" );
print FILE "/*\n";
print FILE " * This file was generated by UCS_to_EUC_JIS_2004.pl\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};
$count1--;
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), substr($index, 8, 8), $code, $comment1{ $index };
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), substr($index, 8, 8), $code,
$comment1{$index};
}
}
print FILE "};\n";
close(FILE);
if ($TEST == 1) {
for $index ( sort {$a cmp $b} keys( %array1 ) ){
if ($TEST == 1)
{
for $index (sort { $a cmp $b } keys(%array1))
{
$code = $array1{$index};
if ($code > 0x00 && $code != 0x09 && $code != 0x0a && $code != 0x0d &&
$code != 0x5c &&
($code < 0x80 ||
($code >= 0x8ea1 && $code <= 0x8efe) ||
($code >= 0x8fa1a1 && $code <= 0x8ffefe) ||
($code >= 0xa1a1 && $code <= 0x8fefe))) {
if ( $code > 0x00
&& $code != 0x09
&& $code != 0x0a
&& $code != 0x0d
&& $code != 0x5c
&& ( $code < 0x80
|| ($code >= 0x8ea1 && $code <= 0x8efe)
|| ($code >= 0x8fa1a1 && $code <= 0x8ffefe)
|| ($code >= 0xa1a1 && $code <= 0x8fefe)))
{
$v1 = hex(substr($index, 0, 8));
$v2 = hex(substr($index, 8, 8));
for ($i = 3; $i >= 0; $i--) {
for ($i = 3; $i >= 0; $i--)
{
$s = $i * 8;
$mask = 0xff << $s;
print FILE1 pack("C", ($v1 & $mask) >> $s) if $v1 & $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;
$mask = 0xff << $s;
print FILE1 pack("C", ($v2 & $mask) >> $s) if $v2 & $mask;
@ -169,8 +206,10 @@ reset 'array1';
reset 'comment';
reset 'comment1';
while($line = <FILE> ){
if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/) {
while ($line = <FILE>)
{
if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/)
{
$c = $1;
$u1 = $2;
$u2 = $3;
@ -185,18 +224,23 @@ while($line = <FILE> ){
$comment1{$code} = $rest;
$count1++;
next;
} elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/) {
}
elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/)
{
$c = $1;
$u = $2;
$rest = "U+" . $u . $3;
} else {
}
else
{
next;
}
$ucs = hex($u);
$code = hex($c);
$utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){
if ($array{$code} ne "")
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
}
@ -214,13 +258,19 @@ print FILE " * This file was generated by UCS_to_EUC_JIS_2004.pl\n";
print FILE " */\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};
$count--;
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, $comment{ $code };
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,
$comment{$code};
}
}
@ -232,15 +282,22 @@ open( FILE, "> $file" ) || die( "cannot open $file" );
print FILE "/*\n";
print FILE " * This file was generated by UCS_to_EUC_JIS_2004.pl\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};
$count1--;
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, substr($code, 0, 8), substr($code, 8, 8), $comment1{ $index };
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,
substr($code, 0, 8), substr($code, 8, 8), $comment1{$index};
}
}

92
src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl
View File

@ -40,17 +40,21 @@ open( FILE, $in_file ) || die( "cannot open $in_file" );
reset 'array';
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($c, $u, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){
if ($array{$utf} ne "")
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
}
@ -69,17 +73,21 @@ $in_file = "JIS0208.TXT";
open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($s, $c, $u, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){
if ($array{$utf} ne "")
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
}
@ -97,17 +105,21 @@ $in_file = "JIS0212.TXT";
open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($c, $u, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){
if ($array{$utf} ne "")
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
}
@ -126,12 +138,16 @@ $file = "utf8_to_euc_jp.map";
open(FILE, "> $file") || die("cannot open $file");
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};
$count--;
if( $count == 0 ){
if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
} else {
}
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
}
}
@ -152,17 +168,21 @@ open( FILE, $in_file ) || die( "cannot open $in_file" );
reset 'array';
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($c, $u, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){
if ($array{$code} ne "")
{
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next;
}
@ -182,17 +202,21 @@ $in_file = "JIS0208.TXT";
open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($s, $c, $u, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){
if ($array{$code} ne "")
{
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next;
}
@ -211,17 +235,21 @@ $in_file = "JIS0212.TXT";
open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($c, $u, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){
if ($array{$code} ne "")
{
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next;
}
@ -236,12 +264,16 @@ close( FILE );
$file = "euc_jp_to_utf8.map";
open(FILE, "> $file") || die("cannot open $file");
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};
$count--;
if( $count == 0 ){
if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
} else {
}
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
}
}

44
src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl
View File

@ -24,17 +24,21 @@ $in_file = "KSX1001.TXT";
open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($c, $u, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){
if ($array{$utf} ne "")
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
}
@ -53,12 +57,16 @@ $file = "utf8_to_euc_kr.map";
open(FILE, "> $file") || die("cannot open $file");
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};
$count--;
if( $count == 0 ){
if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
} else {
}
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
}
}
@ -73,17 +81,21 @@ reset 'array';
open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($c, $u, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){
if ($array{$code} ne "")
{
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next;
}
@ -98,12 +110,16 @@ close( FILE );
$file = "euc_kr_to_utf8.map";
open(FILE, "> $file") || die("cannot open $file");
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};
$count--;
if( $count == 0 ){
if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
} else {
}
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
}
}

63
src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl
View File

@ -25,32 +25,41 @@ $in_file = "CNS11643.TXT";
open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($c, $u, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){
if ($array{$utf} ne "")
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
}
$count++;
$plane = ($code & 0x1f0000) >> 16;
if ($plane > 16) {
if ($plane > 16)
{
printf STDERR "Warning: invalid plane No.$plane. ignored\n";
next;
}
if ($plane == 1) {
if ($plane == 1)
{
$array{$utf} = (($code & 0xffff) | 0x8080);
} else {
$array{ $utf } = (0x8ea00000 + ($plane << 16)) | (($code & 0xffff) | 0x8080);
}
else
{
$array{$utf} =
(0x8ea00000 + ($plane << 16)) | (($code & 0xffff) | 0x8080);
}
}
}
@ -64,12 +73,16 @@ $file = "utf8_to_euc_tw.map";
open(FILE, "> $file") || die("cannot open $file");
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};
$count--;
if( $count == 0 ){
if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
} else {
}
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
}
}
@ -84,29 +97,35 @@ reset 'array';
open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($c, $u, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){
if ($array{$code} ne "")
{
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next;
}
$count++;
$plane = ($code & 0x1f0000) >> 16;
if ($plane > 16) {
if ($plane > 16)
{
printf STDERR "Warning: invalid plane No.$plane. ignored\n";
next;
}
if ($plane == 1) {
if ($plane == 1)
{
$c = (($code & 0xffff) | 0x8080);
$array{$c} = $utf;
$count++;
@ -120,12 +139,16 @@ close( FILE );
$file = "euc_tw_to_utf8.map";
open(FILE, "> $file") || die("cannot open $file");
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};
$count--;
if( $count == 0 ){
if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
} else {
}
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
}
}

44
src/backend/utils/mb/Unicode/UCS_to_GB18030.pl
View File

@ -20,17 +20,21 @@ $in_file = "ISO10646-GB18030.TXT";
open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($u, $c, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){
if ($array{$utf} ne "")
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
}
@ -50,12 +54,16 @@ $file = "utf8_to_gb18030.map";
open(FILE, "> $file") || die("cannot open $file");
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};
$count--;
if( $count == 0 ){
if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
} else {
}
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
}
}
@ -71,17 +79,21 @@ reset 'array';
open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($u, $c, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){
if ($array{$code} ne "")
{
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next;
}
@ -95,12 +107,16 @@ close( FILE );
$file = "gb18030_to_utf8.map";
open(FILE, "> $file") || die("cannot open $file");
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};
$count--;
if( $count == 0 ){
if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
} else {
}
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
}
}

113
src/backend/utils/mb/Unicode/UCS_to_SHIFT_JIS_2004.pl
View File

@ -20,8 +20,10 @@ reset 'array1';
reset 'comment';
reset 'comment1';
while($line = <FILE> ){
if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/) {
while ($line = <FILE>)
{
if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/)
{
$c = $1;
$u1 = $2;
$u2 = $3;
@ -36,19 +38,26 @@ while($line = <FILE> ){
$comment1{$str} = $rest;
$count1++;
next;
} elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/) {
}
elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/)
{
$c = $1;
$u = $2;
$rest = "U+" . $u . $3;
} else {
}
else
{
next;
}
$ucs = hex($u);
$code = hex($c);
$utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){
printf STDERR "Warning: duplicate UTF8: %08x UCS: %04x Shift JIS: %04x\n",$utf, $ucs, $code;
if ($array{$utf} ne "")
{
printf STDERR
"Warning: duplicate UTF8: %08x UCS: %04x Shift JIS: %04x\n", $utf,
$ucs, $code;
next;
}
$count++;
@ -65,13 +74,19 @@ print FILE " * This file was generated by UCS_to_SHIFT_JIS_2004.pl\n";
print FILE " */\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};
$count--;
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, $comment{ $code };
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,
$comment{$code};
}
}
@ -83,15 +98,23 @@ open( FILE, "> $file" ) || die( "cannot open $file" );
print FILE "/*\n";
print FILE " * This file was generated by UCS_to_SHIFT_JIS_2004.pl\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};
$count1--;
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), substr($index, 8, 8), $code, $comment1{ $index };
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), substr($index, 8, 8), $code,
$comment1{$index};
}
}
@ -109,8 +132,10 @@ reset 'array1';
reset 'comment';
reset 'comment1';
while($line = <FILE> ){
if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/) {
while ($line = <FILE>)
{
if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/)
{
$c = $1;
$u1 = $2;
$u2 = $3;
@ -125,19 +150,26 @@ while($line = <FILE> ){
$comment1{$code} = $rest;
$count1++;
next;
} elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/) {
}
elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/)
{
$c = $1;
$u = $2;
$rest = "U+" . $u . $3;
} else {
}
else
{
next;
}
$ucs = hex($u);
$code = hex($c);
$utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){
printf STDERR "Warning: duplicate UTF-8: %08x UCS: %04x Shift JIS: %04x\n",$utf, $ucs, $code;
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};
next;
}
@ -155,13 +187,19 @@ print FILE " * This file was generated by UCS_to_SHIFTJIS_2004.pl\n";
print FILE " */\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};
$count--;
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, $comment{ $code };
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,
$comment{$code};
}
}
@ -173,15 +211,22 @@ open( FILE, "> $file" ) || die( "cannot open $file" );
print FILE "/*\n";
print FILE " * This file was generated by UCS_to_SHIFT_JIS_2004.pl\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};
$count1--;
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, substr($code, 0, 8), substr($code, 8, 8), $comment1{ $index };
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,
substr($code, 0, 8), substr($code, 8, 8), $comment1{$index};
}
}

45
src/backend/utils/mb/Unicode/UCS_to_SJIS.pl
View File

@ -26,18 +26,20 @@ $count = 0;
open(FILE, $in_file) || die("cannot open $in_file");
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($c, $u, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if((( $code >= 0xed40 )
&& ( $code <= 0xeefc ))
if ((($code >= 0xed40) && ($code <= 0xeefc))
|| ( ($code >= 0x8754)
&& ($code <= 0x875d))
|| ($code == 0x878a)
@ -52,7 +54,9 @@ while( <FILE> ){
|| ( ($code >= 0x879a)
&& ($code <= 0x879c)))
{
printf STDERR "Warning: duplicate UTF8 : UCS=0x%04x SJIS=0x%04x\n",$ucs,$code;
printf STDERR
"Warning: duplicate UTF8 : UCS=0x%04x SJIS=0x%04x\n", $ucs,
$code;
next;
}
$count++;
@ -70,12 +74,16 @@ $file = "utf8_to_sjis.map";
open(FILE, "> $file") || die("cannot open $file");
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};
$count--;
if( $count == 0 ){
if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
} else {
}
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
}
}
@ -92,15 +100,18 @@ open( FILE, $in_file ) || die( "cannot open $in_file" );
reset 'array';
$count = 0;
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($c, $u, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080 ){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
$count++;
@ -112,12 +123,16 @@ close( FILE );
$file = "sjis_to_utf8.map";
open(FILE, "> $file") || die("cannot open $file");
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};
$count--;
if( $count == 0 ){
if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
} else {
}
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
}
}

50
src/backend/utils/mb/Unicode/UCS_to_most.pl
View File

@ -46,12 +46,12 @@ require "ucs2utf.pl";
'KOI8U' => 'KOI8-U.TXT',
'GBK' => 'CP936.TXT',
'UHC' => 'CP949.TXT',
'JOHAB' => 'JOHAB.TXT',
);
'JOHAB' => 'JOHAB.TXT',);
@charsets = keys(filename);
@charsets = @ARGV if scalar(@ARGV);
foreach $charset (@charsets) {
foreach $charset (@charsets)
{
#
# first, generate UTF8-> charset table
@ -62,17 +62,21 @@ foreach $charset (@charsets) {
reset 'array';
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($c, $u, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if( $code >= 0x80 && $ucs >= 0x0080){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if( $array{ $utf } ne "" ){
if ($array{$utf} ne "")
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
}
@ -86,12 +90,16 @@ foreach $charset (@charsets) {
open(FILE, "> $file") || die("cannot open $file");
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};
$count--;
if( $count == 0 ){
if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
} else {
}
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
}
}
@ -106,17 +114,21 @@ foreach $charset (@charsets) {
reset 'array';
while( <FILE> ){
while (<FILE>)
{
chop;
if( /^#/ ){
if (/^#/)
{
next;
}
($c, $u, $rest) = split;
$ucs = hex($u);
$code = hex($c);
if($code >= 0x80 && $ucs >= 0x0080){
if ($code >= 0x80 && $ucs >= 0x0080)
{
$utf = &ucs2utf($ucs);
if( $array{ $code } ne "" ){
if ($array{$code} ne "")
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
}
@ -129,12 +141,16 @@ foreach $charset (@charsets) {
$file = lc("${charset}_to_utf8.map");
open(FILE, "> $file") || die("cannot open $file");
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};
$count--;
if( $count == 0 ){
if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
} else {
}
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
}
}

30
src/backend/utils/mb/Unicode/ucs2utf.pl
View File

@ -4,23 +4,31 @@
# src/backend/utils/mb/Unicode/ucs2utf.pl
# convert UCS-4 to UTF-8
#
sub ucs2utf {
sub ucs2utf
{
local ($ucs) = @_;
local $utf;
if ($ucs <= 0x007f) {
if ($ucs <= 0x007f)
{
$utf = $ucs;
} elsif ($ucs > 0x007f && $ucs <= 0x07ff) {
}
elsif ($ucs > 0x007f && $ucs <= 0x07ff)
{
$utf = (($ucs & 0x003f) | 0x80) | ((($ucs >> 6) | 0xc0) << 8);
} elsif ($ucs > 0x07ff && $ucs <= 0xffff) {
$utf = ((($ucs >> 12) | 0xe0) << 16) |
(((($ucs & 0x0fc0) >> 6) | 0x80) << 8) |
(($ucs & 0x003f) | 0x80);
} else {
$utf = ((($ucs >> 18) | 0xf0) << 24) |
}
elsif ($ucs > 0x07ff && $ucs <= 0xffff)
{
$utf =
((($ucs >> 12) | 0xe0) << 16) |
(((($ucs & 0x0fc0) >> 6) | 0x80) << 8) | (($ucs & 0x003f) | 0x80);
}
else
{
$utf =
((($ucs >> 18) | 0xf0) << 24) |
(((($ucs & 0x3ffff) >> 12) | 0x80) << 16) |
(((($ucs & 0x0fc0) >> 6) | 0x80) << 8) |
(($ucs & 0x003f) | 0x80);
(((($ucs & 0x0fc0) >> 6) | 0x80) << 8) | (($ucs & 0x003f) | 0x80);
}
return ($utf);
}

73
src/bin/psql/create_help.pl
View File

@ -22,14 +22,17 @@
use strict;
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 $hfilebasename;
if ($hfile =~ m!.*/([^/]+)$!) {
if ($hfile =~ m!.*/([^/]+)$!)
{
$hfilebasename = $1;
}
else {
else
{
$hfilebasename = $hfile;
}
@ -44,8 +47,7 @@ open(HFILE, ">$hfile")
open(CFILE, ">$cfile")
or die "$0: could not open output file '$cfile': $!\n";
print HFILE
"/*
print HFILE "/*
* *** Do not change this file by hand. It is automatically
* *** generated from the DocBook documentation.
*
@ -72,8 +74,7 @@ struct _helpStruct
";
print CFILE
"/*
print CFILE "/*
* *** Do not change this file by hand. It is automatically
* *** generated from the DocBook documentation.
*
@ -90,7 +91,8 @@ my $maxlen = 0;
my %entries;
foreach my $file (sort readdir DIR) {
foreach my $file (sort readdir DIR)
{
my (@cmdnames, $cmddesc, $cmdsynopsis);
$file =~ /\.sgml$/ or next;
@ -99,15 +101,24 @@ foreach my $file (sort readdir DIR) {
close FILE;
# Ignore files that are not for SQL language statements
$filecontent =~ m!<refmiscinfo>\s*SQL - Language Statements\s*</refmiscinfo>!i
$filecontent =~
m!<refmiscinfo>\s*SQL - Language Statements\s*</refmiscinfo>!i
or next;
# Collect multiple refnames
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;
$filecontent =~ m!<synopsis>\s*(.+?)\s*</synopsis>!is and $cmdsynopsis = $1;
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;
$filecontent =~ m!<synopsis>\s*(.+?)\s*</synopsis>!is
and $cmdsynopsis = $1;
if (@cmdnames && $cmddesc && $cmdsynopsis) {
if (@cmdnames && $cmddesc && $cmdsynopsis)
{
s/\"/\\"/g foreach @cmdnames;
$cmddesc =~ s/<[^>]+>//g;
@ -118,10 +129,12 @@ foreach my $file (sort readdir DIR) {
my $nl_count = () = $cmdsynopsis =~ /\n/g;
$cmdsynopsis =~ m!</>! and die "$0:$file: null end tag not supported in synopsis\n";
$cmdsynopsis =~ m!</>!
and die "$0:$file: null end tag not supported in synopsis\n";
$cmdsynopsis =~ s/%/%%/g;
while ($cmdsynopsis =~ m!<(\w+)[^>]*>(.+?)</\1[^>]*>!) {
while ($cmdsynopsis =~ m!<(\w+)[^>]*>(.+?)</\1[^>]*>!)
{
my $match = $2;
$match =~ s/<[^>]+>//g;
$match =~ s/%%/%/g;
@ -131,25 +144,32 @@ foreach my $file (sort readdir DIR) {
$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;
foreach my $cmdname (@cmdnames)
{
$entries{$cmdname} = {
cmddesc => $cmddesc,
cmdsynopsis => $cmdsynopsis,
params => \@params,
nl_count => $nl_count };
$maxlen =
($maxlen >= length $cmdname) ? $maxlen : length $cmdname;
}
}
else {
else
{
die "$0: parsing file '$file' failed (N='@cmdnames' D='$cmddesc')\n";
}
}
foreach (sort keys %entries) {
foreach (sort keys %entries)
{
my $prefix = "\t" x 5 . ' ';
my $id = $_;
$id =~ s/ /_/g;
my $synopsis = "\"$entries{$_}{cmdsynopsis}\"";
$synopsis =~ s/\\n/\\n"\n$prefix"/g;
my @args = ("buf",
$synopsis,
map("_(\"$_\")", @{$entries{$_}{params}}));
my @args =
("buf", $synopsis, map("_(\"$_\")", @{ $entries{$_}{params} }));
print HFILE "extern void sql_help_$id(PQExpBuffer buf);\n";
print CFILE "void
sql_help_$id(PQExpBuffer buf)
@ -164,7 +184,8 @@ print HFILE "
static const struct _helpStruct QL_HELP[] = {
";
foreach (sort keys %entries) {
foreach (sort keys %entries)
{
my $id = $_;
$id =~ s/ /_/g;
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) */

8
src/interfaces/ecpg/preproc/check_rules.pl
View File

@ -39,12 +39,11 @@ my %replace_line = (
'ExecuteStmtEXECUTEnameexecute_param_clause' =>
'EXECUTE prepared_name execute_param_clause execute_rest',
'ExecuteStmtCREATEOptTempTABLEcreate_as_targetASEXECUTEnameexecute_param_clause' =>
'CREATE OptTemp TABLE create_as_target AS EXECUTE prepared_name execute_param_clause',
'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'
);
'PREPARE prepared_name prep_type_clause AS PreparableStmt');
my $block = '';
my $yaccmode = 0;
@ -96,6 +95,7 @@ while (<GRAM>)
}
elsif ($arr[$fieldIndexer] eq '/*')
{
# start of a multiline comment
$comment = 1;
next;

80
src/interfaces/ecpg/preproc/parse.pl
View File

@ -38,8 +38,7 @@ my %replace_token = (
'FCONST' => 'ecpg_fconst',
'Sconst' => 'ecpg_sconst',
'IDENT' => 'ecpg_ident',
'PARAM' => 'ecpg_param',
);
'PARAM' => 'ecpg_param',);
# or in the block
my %replace_string = (
@ -48,8 +47,7 @@ my %replace_string = (
'NULLS_LAST' => 'nulls last',
'TYPECAST' => '::',
'DOT_DOT' => '..',
'COLON_EQUALS' => ':=',
);
'COLON_EQUALS' => ':=',);
# specific replace_types for specific non-terminals - never include the ':'
# ECPG-only replace_types are defined in ecpg-replace_types
@ -65,8 +63,7 @@ my %replace_types = (
'ColId' => 'ignore',
'type_function_name' => 'ignore',
'ColLabel' => 'ignore',
'Sconst' => 'ignore',
);
'Sconst' => 'ignore',);
# these replace_line commands excise certain keywords from the core keyword
# lists. Be sure to account for these in ColLabel and related productions.
@ -92,16 +89,19 @@ my %replace_line = (
"opt_array_boundsopt_array_bounds'['Iconst']'" => 'ignore',
'VariableShowStmtSHOWvar_name' => 'SHOW var_name ecpg_into',
'VariableShowStmtSHOWTIMEZONE' => 'SHOW TIME ZONE ecpg_into',
'VariableShowStmtSHOWTRANSACTIONISOLATIONLEVEL' => 'SHOW TRANSACTION ISOLATION LEVEL ecpg_into',
'VariableShowStmtSHOWSESSIONAUTHORIZATION' => 'SHOW SESSION AUTHORIZATION ecpg_into',
'returning_clauseRETURNINGtarget_list' => 'RETURNING target_list ecpg_into',
'ExecuteStmtEXECUTEnameexecute_param_clause' => 'EXECUTE prepared_name execute_param_clause execute_rest',
'ExecuteStmtCREATEOptTempTABLEcreate_as_targetASEXECUTEnameexecute_param_clause' =>
'CREATE OptTemp TABLE create_as_target AS EXECUTE prepared_name execute_param_clause',
'VariableShowStmtSHOWTRANSACTIONISOLATIONLEVEL' =>
'SHOW TRANSACTION ISOLATION LEVEL ecpg_into',
'VariableShowStmtSHOWSESSIONAUTHORIZATION' =>
'SHOW SESSION AUTHORIZATION ecpg_into',
'returning_clauseRETURNINGtarget_list' =>
'RETURNING target_list ecpg_into',
'ExecuteStmtEXECUTEnameexecute_param_clause' =>
'EXECUTE prepared_name execute_param_clause execute_rest',
'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',
);
'var_nameColId' => 'ECPGColId',);
preload_addons();
@ -145,7 +145,8 @@ sub main
# len is the number of fields in flds...
# leadin is the padding to apply at the beginning (just use for formatting)
if (/^%%/) {
if (/^%%/)
{
$tokenmode = 2;
$copymode = 1;
$yaccmode++;
@ -197,7 +198,8 @@ sub main
{
next;
}
if ( substr( $a, 0, 1 ) eq '<' ) {
if (substr($a, 0, 1) eq '<')
{
next;
# its a type
@ -207,6 +209,7 @@ sub main
$str = $str . ' ' . $a;
if ($a eq 'IDENT' && $prior eq '%nonassoc')
{
# add two more tokens to the list
$str = $str . "\n%nonassoc CSTRING\n%nonassoc UIDENT";
}
@ -224,7 +227,10 @@ sub main
# 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)
{
@ -237,6 +243,7 @@ sub main
}
elsif ($arr[$fieldIndexer] eq '/*')
{
# start of a multiline comment
$comment = 1;
next;
@ -326,6 +333,7 @@ sub main
# If yes, we'll have already printed the ':'
if (!($arr[$fieldIndexer] =~ '[A-Za-z0-9]+:'))
{
# Consume the ':' which is next...
$line = $line . ':';
$fieldIndexer++;
@ -340,7 +348,10 @@ sub main
{
$stmt_mode = 0;
}
my $tstr = '%type ' . $replace_types{$non_term_id} . ' ' . $non_term_id;
my $tstr =
'%type '
. $replace_types{$non_term_id} . ' '
. $non_term_id;
add_to_buffer('types', $tstr);
if ($copymode)
@ -352,7 +363,8 @@ sub main
$infield = 1;
next;
}
elsif ($copymode) {
elsif ($copymode)
{
$line = $line . ' ' . $arr[$fieldIndexer];
}
if ($arr[$fieldIndexer] eq '%prec')
@ -367,11 +379,10 @@ sub main
&& length($arr[$fieldIndexer])
&& $infield)
{
if (
$arr[$fieldIndexer] ne 'Op'
&& ( $tokens{ $arr[$fieldIndexer] } > 0 || $arr[$fieldIndexer] =~ /'.+'/ )
|| $stmt_mode == 1
)
if ($arr[$fieldIndexer] ne 'Op'
&& ( $tokens{ $arr[$fieldIndexer] } > 0
|| $arr[$fieldIndexer] =~ /'.+'/)
|| $stmt_mode == 1)
{
my $S;
if (exists $replace_string{ $arr[$fieldIndexer] })
@ -474,10 +485,12 @@ sub dump_fields
if ($mode == 0)
{
#Normal
add_to_buffer('rules', $ln);
if ($feature_not_supported == 1)
{
# we found an unsupported feature, but we have to
# filter out ExecuteStmt: CREATE OptTemp TABLE ...
# because the warning there is only valid in some situations
@ -492,11 +505,13 @@ sub dump_fields
if ($len == 0)
{
# We have no fields ?
add_to_buffer('rules', ' $$=EMPTY; }');
}
else
{
# Go through each field and try to 'aggregate' the tokens
# into a single 'mm_strdup' where possible
my @flds_new;
@ -513,8 +528,10 @@ sub dump_fields
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...
push(@flds_new, "mm_strdup(\"$str\")");
last;
@ -528,15 +545,18 @@ sub dump_fields
$len = scalar(@flds_new);
if ($len == 1)
{
# Straight assignement
$str = ' $$ = ' . $flds_new[0] . ';';
add_to_buffer('rules', $str);
}
else
{
# Need to concatenate the results to form
# our final string
$str = ' $$ = cat_str(' . $len . ',' . join(',', @flds_new) . ');';
$str =
' $$ = cat_str(' . $len . ',' . join(',', @flds_new) . ');';
add_to_buffer('rules', $str);
}
add_to_buffer('rules', '}');
@ -544,11 +564,14 @@ sub dump_fields
}
else
{
# we're in the stmt: rule
if ($len)
{
# 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
{
@ -599,13 +622,16 @@ sub dump_line
}
=cut
sub preload_addons
{
my $filename = $path . "/ecpg.addons";
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.
my (@needsRules, @code, $record);
# there may be comments before the first ECPG line, skip them
my $skip = 1;
while (<$fh>)

48
src/pl/plperl/plc_perlboot.pl
View File

@ -7,60 +7,70 @@ PostgreSQL::InServer::Util::bootstrap();
# globals
sub ::is_array_ref {
sub ::is_array_ref
{
return ref($_[0]) =~ m/^(?:PostgreSQL::InServer::)?ARRAY$/;
}
sub ::encode_array_literal {
sub ::encode_array_literal
{
my ($arg, $delim) = @_;
return $arg unless (::is_array_ref($arg));
$delim = ', ' unless defined $delim;
my $res = '';
foreach my $elem (@$arg) {
foreach my $elem (@$arg)
{
$res .= $delim if length $res;
if (ref $elem) {
if (ref $elem)
{
$res .= ::encode_array_literal($elem, $delim);
}
elsif (defined $elem) {
elsif (defined $elem)
{
(my $str = $elem) =~ s/(["\\])/\\$1/g;
$res .= qq("$str");
}
else {
else
{
$res .= 'NULL';
}
}
return qq({$res});
}
sub ::encode_array_constructor {
sub ::encode_array_constructor
{
my $arg = shift;
return ::quote_nullable($arg) unless ::is_array_ref($arg);
my $res = join ", ", map {
(ref $_) ? ::encode_array_constructor($_)
: ::quote_nullable($_)
} @$arg;
my $res = join ", ",
map { (ref $_) ? ::encode_array_constructor($_) : ::quote_nullable($_) }
@$arg;
return "ARRAY[$res]";
}
{
package PostgreSQL::InServer;
use strict;
use warnings;
sub plperl_warn {
sub plperl_warn
{
(my $msg = shift) =~ s/\(eval \d+\) //g;
chomp $msg;
&::elog(&::WARNING, $msg);
}
$SIG{__WARN__} = \&plperl_warn;
sub plperl_die {
sub plperl_die
{
(my $msg = shift) =~ s/\(eval \d+\) //g;
die $msg;
}
$SIG{__DIE__} = \&plperl_die;
sub mkfuncsrc {
sub mkfuncsrc
{
my ($name, $imports, $prolog, $src) = @_;
my $BEGIN = join "\n", map {
@ -72,7 +82,8 @@ sub mkfuncsrc {
return qq[ package main; sub { $BEGIN $prolog $src } ];
}
sub mkfunc {
sub mkfunc
{
no strict; # default to no strict for the eval
no warnings; # default to no warnings for the eval
my $ret = eval(mkfuncsrc(@_));
@ -84,6 +95,7 @@ sub mkfunc {
}
{
package PostgreSQL::InServer::ARRAY;
use strict;
use warnings;
@ -92,12 +104,14 @@ use overload
'""' => \&to_str,
'@{}' => \&to_arr;
sub to_str {
sub to_str
{
my $self = shift;
return ::encode_typed_literal($self->{'array'}, $self->{'typeoid'});
}
sub to_arr {
sub to_arr
{
return shift->{'array'};
}

11
src/pl/plperl/plperl_opmask.pl
View File

@ -19,31 +19,36 @@ printf $fh " memset(opmask, 1, MAXO);\t/* disable all */ \\\n";
printf $fh " /* then allow some... */ \\\n";
my @allowed_ops = (
# basic set of opcodes
qw[:default :base_math !:base_io sort time],
# require is safe because we redirect the opcode
# entereval is safe as the opmask is now permanently set
# caller is safe because the entire interpreter is locked down
qw[require entereval caller],
# These are needed for utf8_heavy.pl:
# dofile is safe because we redirect the opcode like require above
# print is safe because the only writable filehandles are STDOUT & STDERR
# prtf (printf) is safe as it's the same as print + sprintf
qw[dofile print prtf],
# Disallow these opcodes that are in the :base_orig optag
# (included in :default) but aren't considered sufficiently safe
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
# used it. Even then it's unlikely to be seen because it's typically
# generated by compiler plugins that operate after PL_op_mask checks.
# But we err on the side of caution and disable it
qw[!custom],
);
qw[!custom],);
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},
uc($opname), opdesc($opname);
}

12
src/pl/plperl/text2macro.pl
View File

@ -32,8 +32,7 @@ GetOptions(
'prefix=s' => \my $opt_prefix,
'name=s' => \my $opt_name,
'strip=s' => \my $opt_strip,
'selftest!' => sub { exit selftest() },
) or exit 1;
'selftest!' => sub { exit selftest() },) or exit 1;
die "No text files specified"
unless @ARGV;
@ -45,7 +44,8 @@ print qq{
*/
};
for my $src_file (@ARGV) {
for my $src_file (@ARGV)
{
(my $macro = $src_file) =~ s/ .*? (\w+) (?:\.\w+) $/$1/x;
@ -55,7 +55,8 @@ for my $src_file (@ARGV) {
printf qq{#define %s%s \\\n},
$opt_prefix || '',
($opt_name) ? $opt_name : uc $macro;
while (<$src_fh>) {
while (<$src_fh>)
{
chomp;
next if $opt_strip and m/$opt_strip/o;
@ -74,7 +75,8 @@ print "/* end */\n";
exit 0;
sub selftest {
sub selftest
{
my $tmp = "text2macro_tmp";
my $string = q{a '' '\\'' "" "\\"" "\\\\" "\\\\n" b};

12
src/pl/plpgsql/src/generate-plerrcodes.pl
View File

@ -6,12 +6,14 @@
use warnings;
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";
open my $errcodes, $ARGV[0] or die;
while (<$errcodes>) {
while (<$errcodes>)
{
chomp;
# Skip comments
@ -23,10 +25,8 @@ while (<$errcodes>) {
die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/;
(my $sqlstate,
my $type,
my $errcode_macro,
my $condition_name) = ($1, $2, $3, $4);
(my $sqlstate, my $type, my $errcode_macro, my $condition_name) =
($1, $2, $3, $4);
# Skip non-errors
next unless $type eq 'E';

16
src/pl/plpython/generate-spiexceptions.pl
View File

@ -6,12 +6,14 @@
use warnings;
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";
open my $errcodes, $ARGV[0] or die;
while (<$errcodes>) {
while (<$errcodes>)
{
chomp;
# Skip comments
@ -23,10 +25,8 @@ while (<$errcodes>) {
die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/;
(my $sqlstate,
my $type,
my $errcode_macro,
my $condition_name) = ($1, $2, $3, $4);
(my $sqlstate, my $type, my $errcode_macro, my $condition_name) =
($1, $2, $3, $4);
# Skip non-errors
next unless $type eq 'E';
@ -37,8 +37,8 @@ while (<$errcodes>) {
# Change some_error_condition to SomeErrorCondition
$condition_name =~ s/([a-z])([^_]*)(?:_|$)/\u$1$2/g;
print "{ \"spiexceptions.$condition_name\", " .
"\"$condition_name\", $errcode_macro },\n";
print "{ \"spiexceptions.$condition_name\", "
. "\"$condition_name\", $errcode_macro },\n";
}
close $errcodes;

27
src/test/performance/runtests.pl
View File

@ -10,9 +10,9 @@ $DBNAME = 'perftest';
# This describtion for all DBMS supported by test
# DBMS_name => [FrontEnd, DestroyDB command, CreateDB command]
%DBMS = (
'pgsql' => ["psql -q -d $DBNAME", "destroydb $DBNAME", "createdb $DBNAME"]
);
%DBMS =
('pgsql' =>
[ "psql -q -d $DBNAME", "destroydb $DBNAME", "createdb $DBNAME" ]);
# Tests to run: test' script, test' description, ...
# Test' script is in form
@ -34,30 +34,37 @@ $DBNAME = 'perftest';
# an idea of what can be done for features unsupported by an DBMS.)
#
@perftests = (
# It speed up things
'connection.ntm', 'DB connection startup (no timing)',
# Just connection startup time (echo "" | psql ... - for PgSQL)
'connection', 'DB connection startup',
'crtsimple.ntm', 'Create SIMPLE table (no timing)',
# 8192 inserts in single xaction
'inssimple T', '8192 INSERTs INTO SIMPLE (1 xact)',
'drpsimple.ntm', 'Drop SIMPLE table (no timing)',
'crtsimple.ntm', 'Create SIMPLE table (no timing)',
# 8192 inserts in 8192 xactions
'inssimple', '8192 INSERTs INTO SIMPLE (8192 xacts)',
'vacuum.ntm', 'Vacuum (no timing)',
# Fast (after table filled with data) index creation test
'crtsimpleidx', 'Create INDEX on SIMPLE',
'drpsimple.ntm', 'Drop SIMPLE table (no timing)',
'crtsimple.ntm', 'Create SIMPLE table (no timing)',
'crtsimpleidx.ntm', 'Create INDEX on SIMPLE (no timing)',
# 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',
);
'orbsimple', 'ORDER BY SIMPLE',);
#
# It seems that nothing below need to be changed
@ -82,7 +89,8 @@ open (SAVEOUT, ">&STDOUT");
open(STDOUT, ">/dev/null") or die;
open(SAVEERR, ">&STDERR");
open(STDERR, ">$TmpFile") or die;
select (STDERR); $| = 1;
select(STDERR);
$| = 1;
for ($i = 0; $i <= $#perftests; $i++)
{
@ -91,6 +99,7 @@ for ($i = 0; $i <= $#perftests; $i++)
$runtest = $test;
if ($test =~ /\.ntm/)
{
#
# No timing for this queries
#
@ -105,7 +114,8 @@ for ($i = 0; $i <= $#perftests; $i++)
print STDOUT "\nRunning: $perftests[$i+1] ...";
close(STDOUT);
open(STDOUT, ">/dev/null") or die;
select (STDERR); $| = 1;
select(STDERR);
$| = 1;
printf "$perftests[$i+1]: ";
}
@ -118,7 +128,8 @@ for ($i = 0; $i <= $#perftests; $i++)
open(STDERR, ">>$TmpFile") or die;
}
select (STDERR); $| = 1;
select(STDERR);
$| = 1;
$i++;
}

38
src/tools/check_bison_recursion.pl
View File

@ -32,22 +32,33 @@ my $cur_nonterminal;
# We parse the input and emit warnings on the fly.
my $in_grammar = 0;
while (<>) {
while (<>)
{
my $rule_number;
my $rhs;
# We only care about the "Grammar" part of the input.
if (m/^Grammar$/) {
if (m/^Grammar$/)
{
$in_grammar = 1;
} elsif (m/^Terminal/) {
}
elsif (m/^Terminal/)
{
$in_grammar = 0;
} elsif ($in_grammar) {
if (m/^\s*(\d+)\s+(\S+):\s+(.*)$/) {
}
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+(.*)$/) {
}
elsif (m/^\s*(\d+)\s+\|\s+(.*)$/)
{
# additional rule for nonterminal
$rule_number = $1;
$rhs = $2;
@ -55,18 +66,23 @@ while (<>) {
}
# Process rule if we found one
if (defined $rule_number) {
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;
# We complain if the nonterminal appears as the last RHS element
# but not elsewhere, since "expr := expr + expr" is reasonable
my $lastrhs = pop @rhs;
if (defined $lastrhs &&
$cur_nonterminal eq $lastrhs &&
!grep { $cur_nonterminal eq $_ } @rhs) {
print "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";
}
}
}

115
src/tools/check_keywords.pl
View File

@ -10,15 +10,19 @@ use strict;
my $errors = 0;
my $path;
sub error(@) {
sub error(@)
{
print STDERR @_;
$errors = 1;
}
if (@ARGV) {
if (@ARGV)
{
$path = $ARGV[0];
shift @ARGV;
} else {
}
else
{
$path = ".";
}
@ -39,21 +43,28 @@ my $comment;
my @arr;
my %keywords;
line: while (<GRAM>) {
line: while (<GRAM>)
{
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)) {
if (!($kcat))
{
# Is this the beginning of a keyword list?
foreach $k (keys %keyword_categories) {
if ($S =~ m/^($k):/) {
foreach $k (keys %keyword_categories)
{
if ($S =~ m/^($k):/)
{
$kcat = $k;
next line;
}
@ -65,30 +76,39 @@ line: while (<GRAM>) {
$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) {
for (my $fieldIndexer = 0; $fieldIndexer < $n; $fieldIndexer++)
{
if ($arr[$fieldIndexer] eq '*/' && $comment)
{
$comment = 0;
next;
}
elsif ($comment) {
elsif ($comment)
{
next;
}
elsif ($arr[$fieldIndexer] eq '/*') {
elsif ($arr[$fieldIndexer] eq '/*')
{
# start of a multiline comment
$comment = 1;
next;
}
elsif ($arr[$fieldIndexer] eq '//') {
elsif ($arr[$fieldIndexer] eq '//')
{
next line;
}
if ($arr[$fieldIndexer] eq ';') {
if ($arr[$fieldIndexer] eq ';')
{
# end of keyword list
$kcat = '';
next;
}
if ($arr[$fieldIndexer] eq '|') {
if ($arr[$fieldIndexer] eq '|')
{
next;
}
@ -100,15 +120,20 @@ close GRAM;
# Check that all keywords are in alphabetical order
my ($prevkword, $kword, $bare_kword);
foreach $kcat (keys %keyword_categories) {
foreach $kcat (keys %keyword_categories)
{
$prevkword = '';
foreach $kword (@{$keywords{$kcat}}) {
foreach $kword (@{ $keywords{$kcat} })
{
# Some keyword have a _P suffix. Remove it for the comparison.
$bare_kword = $kword;
$bare_kword =~ s/_P$//;
if ($bare_kword le $prevkword) {
error "'$bare_kword' after '$prevkword' in $kcat list is misplaced";
if ($bare_kword le $prevkword)
{
error
"'$bare_kword' after '$prevkword' in $kcat list is misplaced";
$errors = 1;
}
$prevkword = $bare_kword;
@ -120,7 +145,8 @@ foreach $kcat (keys %keyword_categories) {
# UNRESERVED_KEYWORD. Each inner hash is a keyed by keyword id, e.g. ABORT_P
# with a dummy value.
my %kwhashes;
while ( my ($kcat, $kcat_id) = each(%keyword_categories) ) {
while (my ($kcat, $kcat_id) = each(%keyword_categories))
{
@arr = @{ $keywords{$kcat} };
my $hash;
@ -137,7 +163,8 @@ open(KWLIST, $kwlist_filename) || die("Could not open : $kwlist_filename");
my $prevkwstring = '';
my $bare_kwname;
my %kwhash;
kwlist_line: while (<KWLIST>) {
kwlist_line: while (<KWLIST>)
{
my ($line) = $_;
if ($line =~ /^PG_KEYWORD\(\"(.*)\", (.*), (.*)\)/)
@ -147,37 +174,53 @@ kwlist_line: while (<KWLIST>) {
my ($kwcat_id) = $3;
# Check that the list is in alphabetical order
if ($kwstring le $prevkwstring) {
error "'$kwstring' after '$prevkwstring' in kwlist.h is misplaced";
if ($kwstring le $prevkwstring)
{
error
"'$kwstring' after '$prevkwstring' in kwlist.h is misplaced";
}
$prevkwstring = $kwstring;
# Check that the keyword string is valid: all lower-case ASCII chars
if ($kwstring !~ /^[a-z_]*$/) {
error "'$kwstring' is not a valid keyword string, must be all lower-case ASCII chars";
if ($kwstring !~ /^[a-z_]*$/)
{
error
"'$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";
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'";
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)) {
if (!(%kwhash))
{
#error "Unknown kwcat_id: $kwcat_id";
} else {
if (!($kwhash{$kwname})) {
}
else
{
if (!($kwhash{$kwname}))
{
error "'$kwname' not present in $kwcat_id section of gram.y";
} else {
}
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};
@ -188,11 +231,13 @@ kwlist_line: while (<KWLIST>) {
close KWLIST;
# 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} };
for my $kw ( keys %kwhash ) {
error "'$kw' found in gram.y $kwcat category, but not in kwlist.h"
for my $kw (keys %kwhash)
{
error "'$kw' found in gram.y $kwcat category, but not in kwlist.h";
}
}

14
src/tools/copyright.pl
View File

@ -15,6 +15,7 @@ use Tie::File;
my $pgdg = 'PostgreSQL Global Development Group';
my $cc = 'Copyright \(c\) ';
# year-1900 is what localtime(time) puts in element 5
my $year = 1900 + ${ [ localtime(time) ] }[5];
@ -22,7 +23,9 @@ print "Using current year: $year\n";
find({ wanted => \&wanted, no_chdir => 1 }, '.');
sub wanted {
sub wanted
{
# prevent corruption of git indexes by ignoring any .git/
if ($_ eq '.git')
{
@ -31,9 +34,12 @@ sub wanted {
}
return if !-f $File::Find::name || -l $File::Find::name;
# skip file names with binary extensions
# How are these updated? bjm 2012-01-02
return if ($_ =~ m/\.(ico|bin)$);
return
if (
$_ =~ m/\.(ico|bin)$);
my @lines;
tie @lines, "Tie::File", $File::Find::name;
@ -41,6 +47,7 @@ sub wanted {
foreach my $line (@lines) {
# We only care about lines with a copyright notice.
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
# correctness.
@ -51,5 +58,6 @@ sub wanted {
untie @lines;
}
print "Manually update doc/src/sgml/legal.sgml and src/interfaces/libpq/libpq.rc.in too\n";
print
"Manually update doc/src/sgml/legal.sgml and src/interfaces/libpq/libpq.rc.in too\n";

132
src/tools/msvc/Install.pm
View File

@ -56,62 +56,60 @@ sub Install
my $majorver = DetermineMajorVersion();
print "Installing version $majorver for $conf in $target\n";
EnsureDirectories($target, 'bin', 'lib', 'share','share/timezonesets','share/extension',
'share/contrib','doc','doc/extension', 'doc/contrib','symbols',
'share/tsearch_data');
EnsureDirectories(
$target, 'bin',
'lib', 'share',
'share/timezonesets', 'share/extension',
'share/contrib', 'doc',
'doc/extension', 'doc/contrib',
'symbols', 'share/tsearch_data');
CopySolutionOutput($conf, $target);
lcopy($target . '/lib/libpq.dll', $target . '/bin/libpq.dll');
my $sample_files = [];
File::Find::find(
{
wanted =>sub {
{ wanted => sub {
/^.*\.sample\z/s
&& push(@$sample_files, $File::Find::name);
}
},
"src"
);
"src");
CopySetOfFiles('config files', $sample_files, $target . '/share/');
CopyFiles(
'Import libraries',
$target .'/lib/',
"$conf\\", "postgres\\postgres.lib","libpq\\libpq.lib", "libecpg\\libecpg.lib",
"libpgport\\libpgport.lib"
);
'Import libraries', $target . '/lib/',
"$conf\\", "postgres\\postgres.lib",
"libpq\\libpq.lib", "libecpg\\libecpg.lib",
"libpgport\\libpgport.lib");
CopySetOfFiles(
'timezone names',
[ glob('src\timezone\tznames\*.txt') ],
$target . '/share/timezonesets/'
);
$target . '/share/timezonesets/');
CopyFiles(
'timezone sets',
$target . '/share/timezonesets/',
'src/timezone/tznames/', 'Default','Australia','India'
);
'src/timezone/tznames/', 'Default', 'Australia', 'India');
CopySetOfFiles(
'BKI files',
[ glob("src\\backend\\catalog\\postgres.*") ],
$target .'/share/'
);
CopySetOfFiles('SQL files', [ glob("src\\backend\\catalog\\*.sql") ],$target . '/share/');
$target . '/share/');
CopySetOfFiles(
'SQL files',
[ glob("src\\backend\\catalog\\*.sql") ],
$target . '/share/');
CopyFiles(
'Information schema data', $target . '/share/',
'src/backend/catalog/', 'sql_features.txt'
);
'src/backend/catalog/', 'sql_features.txt');
GenerateConversionScript($target);
GenerateTimezoneFiles($target, $conf);
GenerateTsearchFiles($target);
CopySetOfFiles(
'Stopword files',
[ glob("src\\backend\\snowball\\stopwords\\*.stop") ],
$target . '/share/tsearch_data/'
);
$target . '/share/tsearch_data/');
CopySetOfFiles(
'Dictionaries sample files',
[ glob("src\\backend\\tsearch\\*_sample.*") ],
$target . '/share/tsearch_data/'
);
$target . '/share/tsearch_data/');
CopyContribFiles($config, $target);
CopyIncludeFiles($target);
@ -121,16 +119,14 @@ sub Install
push @pldirs, "src/pl/plpython" if $config->{python};
push @pldirs, "src/pl/tcl" if $config->{tcl};
File::Find::find(
{
wanted =>sub {
{ wanted => sub {
/^(.*--.*\.sql|.*\.control)\z/s
&&push(@$pl_extension_files,
$File::Find::name);
&& push(@$pl_extension_files, $File::Find::name);
}
},
@pldirs
);
CopySetOfFiles('PL Extension files', $pl_extension_files,$target . '/share/extension/');
@pldirs);
CopySetOfFiles('PL Extension files',
$pl_extension_files, $target . '/share/extension/');
GenerateNLSFiles($target, $config->{nls}, $majorver) if ($config->{nls});
@ -185,12 +181,15 @@ sub CopySolutionOutput
{
my $conf = 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 $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';
}
@ -204,7 +203,8 @@ sub CopySolutionOutput
$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 ($1 == 1)
@ -284,7 +284,8 @@ sub GenerateConversionScript
$sql .= "DROP CONVERSION pg_catalog.$name;\n";
$sql .=
"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")
|| die "Could not write to conversion_create.sql\n";
@ -299,7 +300,8 @@ sub GenerateTimezoneFiles
my $conf = shift;
my $mf = read_file("src/timezone/Makefile");
$mf =~ s{\\\s*[\r\n]+}{}mg;
$mf =~ /^TZDATA\s*:?=\s*(.*)$/m || die "Could not find TZDATA row in timezone makefile\n";
$mf =~ /^TZDATA\s*:?=\s*(.*)$/m
|| die "Could not find TZDATA row in timezone makefile\n";
my @tzfiles = split /\s+/, $1;
unshift @tzfiles, '';
print "Generating timezone files...";
@ -455,13 +457,18 @@ sub ParseAndCleanRule
{
my $pcount = 0;
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 ')');
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;
}
@ -477,49 +484,45 @@ sub CopyIncludeFiles
'Public headers',
$target . '/include/',
'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/')
|| croak 'Could not copy libpq-fs.h';
CopyFiles(
'Libpq headers',
$target . '/include/',
'src/interfaces/libpq/','libpq-fe.h', 'libpq-events.h'
);
'src/interfaces/libpq/', 'libpq-fe.h', 'libpq-events.h');
CopyFiles(
'Libpq internal headers',
$target . '/include/internal/',
'src/interfaces/libpq/', 'libpq-int.h', 'pqexpbuffer.h'
);
'src/interfaces/libpq/', 'libpq-int.h', 'pqexpbuffer.h');
CopyFiles(
'Internal headers',
$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/')
|| croak 'Could not copy pqcomm.h';
CopyFiles(
'Server headers',
$target . '/include/server/',
'src/include/', 'pg_config.h', 'pg_config_os.h'
);
'src/include/', 'pg_config.h', 'pg_config_os.h');
CopyFiles(
'Grammar header',
$target . '/include/server/parser/',
'src/backend/parser/','gram.h'
);
CopySetOfFiles('',[ glob("src\\include\\*.h") ],$target . '/include/server/');
'src/backend/parser/', 'gram.h');
CopySetOfFiles(
'',
[ glob("src\\include\\*.h") ],
$target . '/include/server/');
my $D;
opendir($D, 'src/include') || croak "Could not opendir on src/include!\n";
CopyFiles(
'PL/pgSQL header',
$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
(my $ctarget = $target) =~ s!/!\\!g;
@ -539,21 +542,21 @@ qq{xcopy /s /i /q /r /y src\\include\\$d\\*.h "$ctarget\\include\\server\\$d\\"}
my $mf = read_file('src/interfaces/ecpg/include/Makefile');
$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(
'ECPG headers',
$target . '/include/',
'src/interfaces/ecpg/include/',
'ecpg_config.h', split /\s+/,$1
);
$mf =~ /^informix_headers\s*=\s*(.*)$/m || croak "Could not find informix_headers line\n";
'ecpg_config.h', split /\s+/, $1);
$mf =~ /^informix_headers\s*=\s*(.*)$/m
|| croak "Could not find informix_headers line\n";
EnsureDirectories($target . '/include', 'informix', 'informix/esql');
CopyFiles(
'ECPG informix headers',
$target . '/include/informix/esql/',
'src/interfaces/ecpg/include/',
split /\s+/,$1
);
split /\s+/, $1);
}
sub GenerateNLSFiles
@ -566,14 +569,12 @@ sub GenerateNLSFiles
EnsureDirectories($target, "share/locale");
my @flist;
File::Find::find(
{
wanted =>sub {
{ wanted => sub {
/^nls\.mk\z/s
&& !push(@flist, $File::Find::name);
}
},
"src"
);
"src");
foreach (@flist)
{
my $prgm = DetermineCatalogName($_);
@ -599,7 +600,8 @@ sub GenerateNLSFiles
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
|| croak 'Could not determine major version';
return $1;

25
src/tools/msvc/MSBuildProject.pm
View File

@ -40,8 +40,10 @@ EOF
</PropertyGroup>
<Import Project="\$(VCTargetsPath)\\Microsoft.Cpp.Default.props" />
EOF
$self->WriteConfigurationPropertyGroup($f, 'Release',{wholeopt=>'false'});
$self->WriteConfigurationPropertyGroup($f, 'Debug',{wholeopt=>'false'});
$self->WriteConfigurationPropertyGroup($f, 'Release',
{ wholeopt => 'false' });
$self->WriteConfigurationPropertyGroup($f, 'Debug',
{ wholeopt => 'false' });
print $f <<EOF;
<Import Project="\$(VCTargetsPath)\\Microsoft.Cpp.props" />
<ImportGroup Label="ExtensionSettings">
@ -61,15 +63,17 @@ EOF
EOF
$self->WriteItemDefinitionGroup(
$f, 'Debug',
{
defs=>'_DEBUG;DEBUG=1;',
{ defs => '_DEBUG;DEBUG=1;',
opt => 'Disabled',
strpool => 'false',
runtime=>'MultiThreadedDebugDLL'
}
);
$self->WriteItemDefinitionGroup($f, 'Release',
{defs=>'', opt=>'Full', strpool=>'true', runtime=>'MultiThreadedDLL'});
runtime => 'MultiThreadedDebugDLL' });
$self->WriteItemDefinitionGroup(
$f,
'Release',
{ defs => '',
opt => 'Full',
strpool => 'true',
runtime => 'MultiThreadedDLL' });
}
sub AddDefine
@ -273,7 +277,8 @@ sub WriteItemDefinitionGroup
: ($self->{type} eq "dll" ? 'DynamicLibrary' : 'StaticLibrary');
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};
unless ($includes eq '' or $includes =~ /;$/)

187
src/tools/msvc/Mkvcbuild.pm
View File

@ -28,17 +28,19 @@ my $postgres;
my $libpq;
my $contrib_defines = { 'refint' => 'REFINT_VERBOSE' };
my @contrib_uselibpq = ('dblink', 'oid2name', 'pgbench', 'pg_upgrade','vacuumlo');
my @contrib_uselibpq =
('dblink', 'oid2name', 'pgbench', 'pg_upgrade', 'vacuumlo');
my @contrib_uselibpgport = (
'oid2name', 'pgbench', 'pg_standby','pg_archivecleanup',
'pg_test_fsync', 'pg_test_timing', 'pg_upgrade', 'vacuumlo'
);
'oid2name', 'pgbench',
'pg_standby', 'pg_archivecleanup',
'pg_test_fsync', 'pg_test_timing',
'pg_upgrade', 'vacuumlo');
my $contrib_extralibs = { 'pgbench' => ['wsock32.lib'] };
my $contrib_extraincludes = {'tsearch2' => ['contrib/tsearch2'], 'dblink' => ['src/backend']};
my $contrib_extraincludes =
{ 'tsearch2' => ['contrib/tsearch2'], 'dblink' => ['src/backend'] };
my $contrib_extrasource = {
'cube' => [ 'cubescan.l', 'cubeparse.y' ],
'seg' => ['segscan.l','segparse.y']
};
'seg' => [ 'segscan.l', 'segparse.y' ] };
my @contrib_excludes = ('pgcrypto', 'intagg', 'sepgsql');
sub mkvcbuild
@ -46,7 +48,8 @@ sub mkvcbuild
our $config = shift;
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();
@ -68,16 +71,23 @@ sub mkvcbuild
$postgres->AddIncludeDir('src\backend');
$postgres->AddDir('src\backend\port\win32');
$postgres->AddFile('src\backend\utils\fmgrtab.c');
$postgres->ReplaceFile('src\backend\port\dynloader.c','src\backend\port\dynloader\win32.c');
$postgres->ReplaceFile('src\backend\port\pg_sema.c','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->ReplaceFile(
'src\backend\port\dynloader.c',
'src\backend\port\dynloader\win32.c');
$postgres->ReplaceFile('src\backend\port\pg_sema.c',
'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->AddFiles('src\backend\parser', 'scan.l', 'gram.y');
$postgres->AddFiles('src\backend\bootstrap','bootscanner.l','bootparse.y');
$postgres->AddFiles('src\backend\bootstrap', 'bootscanner.l',
'bootparse.y');
$postgres->AddFiles('src\backend\utils\misc', 'guc-file.l');
$postgres->AddFiles('src\backend\replication', 'repl_scanner.l', 'repl_gram.y');
$postgres->AddFiles('src\backend\replication', 'repl_scanner.l',
'repl_gram.y');
$postgres->AddDefine('BUILDING_DLL');
$postgres->AddLibrary('wsock32.lib');
$postgres->AddLibrary('ws2_32.lib');
@ -85,24 +95,26 @@ sub mkvcbuild
$postgres->AddLibrary('wldap32.lib') if ($solution->{options}->{ldap});
$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(
'src\backend\snowball\libstemmer',
sub {
return shift !~ /dict_snowball.c$/;
}
);
});
$snowball->AddIncludeDir('src\include\snowball');
$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->AddReference($postgres);
if ($solution->{options}->{perl})
{
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->AddDefine('PLPERL_HAVE_UID_GID');
foreach my $xs ('SPI.xs', 'Util.xs')
@ -126,13 +138,12 @@ sub mkvcbuild
}
}
}
if (
Solution::IsNewer('src\pl\plperl\perlchunks.h',
if (Solution::IsNewer(
'src\pl\plperl\perlchunks.h',
'src\pl\plperl\plc_perlboot.pl')
|| 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";
my $basedir = getcwd;
@ -144,18 +155,16 @@ sub mkvcbuild
. 'plc_perlboot.pl plc_trusted.pl '
. '>perlchunks.h');
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
die 'Failed to create perlchunks.h' . "\n";
}
}
if (
Solution::IsNewer(
if (Solution::IsNewer(
'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";
my $basedir = getcwd;
@ -174,7 +183,8 @@ sub mkvcbuild
}
$plperl->AddReference($postgres);
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)
{
$plperl->AddLibrary($perl_libs[0]);
@ -206,8 +216,8 @@ sub mkvcbuild
if (!(defined($pyprefix) && defined($pyver)));
my $pymajorver = substr($pyver, 0, 1);
my $plpython =
$solution->AddProject('plpython' . $pymajorver, 'dll','PLs', 'src\pl\plpython');
my $plpython = $solution->AddProject('plpython' . $pymajorver,
'dll', 'PLs', 'src\pl\plpython');
$plpython->AddIncludeDir($pyprefix . '\include');
$plpython->AddLibrary($pyprefix . "\\Libs\\python$pyver.lib");
$plpython->AddReference($postgres);
@ -215,20 +225,24 @@ sub mkvcbuild
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->AddReference($postgres);
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
{
$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('UNSAFE_STAT_OK');
$libpq->AddIncludeDir('src\port');
@ -237,23 +251,26 @@ sub mkvcbuild
$libpq->AddLibrary('ws2_32.lib');
$libpq->AddLibrary('wldap32.lib') if ($solution->{options}->{ldap});
$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);
my $libpqwalreceiver = $solution->AddProject('libpqwalreceiver', 'dll', '',
my $libpqwalreceiver =
$solution->AddProject('libpqwalreceiver', 'dll', '',
'src\backend\replication\libpqwalreceiver');
$libpqwalreceiver->AddIncludeDir('src\interfaces\libpq');
$libpqwalreceiver->AddReference($postgres, $libpq);
my $pgtypes =
$solution->AddProject('libpgtypes','dll','interfaces','src\interfaces\ecpg\pgtypeslib');
my $pgtypes = $solution->AddProject(
'libpgtypes', 'dll',
'interfaces', 'src\interfaces\ecpg\pgtypeslib');
$pgtypes->AddDefine('FRONTEND');
$pgtypes->AddReference($libpgport);
$pgtypes->UseDef('src\interfaces\ecpg\pgtypeslib\pgtypeslib.def');
$pgtypes->AddIncludeDir('src\interfaces\ecpg\include');
my $libecpg =
$solution->AddProject('libecpg','dll','interfaces','src\interfaces\ecpg\ecpglib');
my $libecpg = $solution->AddProject('libecpg', 'dll', 'interfaces',
'src\interfaces\ecpg\ecpglib');
$libecpg->AddDefine('FRONTEND');
$libecpg->AddIncludeDir('src\interfaces\ecpg\include');
$libecpg->AddIncludeDir('src\interfaces\libpq');
@ -262,14 +279,16 @@ sub mkvcbuild
$libecpg->AddLibrary('wsock32.lib');
$libecpg->AddReference($libpq, $pgtypes, $libpgport);
my $libecpgcompat =$solution->AddProject('libecpg_compat','dll','interfaces',
'src\interfaces\ecpg\compatlib');
my $libecpgcompat = $solution->AddProject(
'libecpg_compat', 'dll',
'interfaces', 'src\interfaces\ecpg\compatlib');
$libecpgcompat->AddIncludeDir('src\interfaces\ecpg\include');
$libecpgcompat->AddIncludeDir('src\interfaces\libpq');
$libecpgcompat->UseDef('src\interfaces\ecpg\compatlib\compatlib.def');
$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\libpq');
$ecpg->AddPrefixInclude('src\interfaces\ecpg\preproc');
@ -280,7 +299,8 @@ sub mkvcbuild
$ecpg->AddDefine('ECPG_COMPILE');
$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\test\regress\pg_regress.c');
$pgregress_ecpg->AddIncludeDir('src\port');
@ -289,7 +309,8 @@ sub mkvcbuild
$pgregress_ecpg->AddDefine('FRONTEND');
$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\specparse.y');
$isolation_tester->AddFile('src\test\isolation\specscanner.l');
@ -303,7 +324,8 @@ sub mkvcbuild
$isolation_tester->AddLibrary('wsock32.lib');
$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\regress\pg_regress.c');
$pgregress_isolation->AddIncludeDir('src\port');
@ -339,7 +361,8 @@ sub mkvcbuild
my $pgevent = $solution->AddProject('pgevent', 'dll', 'bin');
$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->UseDef('src\bin\pgevent\pgevent.def');
$pgevent->DisableLinkerWarnings('4104');
@ -382,7 +405,8 @@ sub mkvcbuild
$pgrestore->AddFile('src\backend\parser\kwlookup.c');
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);
if ($solution->{options}->{xml})
@ -390,13 +414,11 @@ sub mkvcbuild
$contrib_extraincludes->{'pgxml'} = [
$solution->{options}->{xml} . '\include',
$solution->{options}->{xslt} . '\include',
$solution->{options}->{iconv} . '\include'
];
$solution->{options}->{iconv} . '\include' ];
$contrib_extralibs->{'pgxml'} = [
$solution->{options}->{xml} . '\lib\libxml2.lib',
$solution->{options}->{xslt} . '\lib\libxslt.lib'
];
$solution->{options}->{xslt} . '\lib\libxslt.lib' ];
}
else
{
@ -423,16 +445,22 @@ sub mkvcbuild
# Pgcrypto makefile too complex to parse....
my $pgcrypto = $solution->AddProject('pgcrypto', 'dll', 'crypto');
$pgcrypto->AddFiles(
'contrib\pgcrypto','pgcrypto.c','px.c','px-hmac.c',
'px-crypt.c','crypt-gensalt.c','crypt-blowfish.c','crypt-des.c',
'crypt-md5.c','mbuf.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'
);
'contrib\pgcrypto', 'pgcrypto.c',
'px.c', 'px-hmac.c',
'px-crypt.c', 'crypt-gensalt.c',
'crypt-blowfish.c', 'crypt-des.c',
'crypt-md5.c', 'mbuf.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})
{
$pgcrypto->AddFiles('contrib\pgcrypto', 'openssl.c','pgp-mpi-openssl.c');
$pgcrypto->AddFiles('contrib\pgcrypto', 'openssl.c',
'pgp-mpi-openssl.c');
}
else
{
@ -442,8 +470,7 @@ sub mkvcbuild
'internal.c', 'internal-sha2.c',
'blf.c', 'rijndael.c',
'fortuna.c', 'random.c',
'pgp-mpi-internal.c','imath.c'
);
'pgp-mpi-internal.c', 'imath.c');
}
$pgcrypto->AddReference($postgres);
$pgcrypto->AddLibrary('wsock32.lib');
@ -461,29 +488,37 @@ sub mkvcbuild
}
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 =~ m{SUBDIRS\s*=\s*(.*)$}m || die 'Could not match in conversion makefile' . "\n";
$mf =~ m{SUBDIRS\s*=\s*(.*)$}m
|| die 'Could not match in conversion makefile' . "\n";
foreach my $sub (split /\s+/, $1)
{
my $mf = Project::read_file(
'src\backend\utils\mb\conversion_procs\\' . $sub . '\Makefile');
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)
{
$p->AddFile('src\backend\utils\mb\conversion_procs\\' . $sub . '\\' . $1);
$p->AddFile(
'src\backend\utils\mb\conversion_procs\\' . $sub . '\\' . $1);
}
$p->AddReference($postgres);
}
$mf = Project::read_file('src\bin\scripts\Makefile');
$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
|| die 'Could not match in bin\scripts\Makefile' . "\n";
foreach my $prg (split /\s+/, $1)
{
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
|| die 'Could not find script define for $prg' . "\n";
my @files = split /\s+/, $1;
foreach my $f (@files)
{
@ -578,8 +613,8 @@ sub AddContrib
{
foreach my $d (split /\s+/, $1)
{
my $mf2 =
Project::read_file('contrib\\' . $n . '\\' . $d . '\Makefile');
my $mf2 = Project::read_file(
'contrib\\' . $n . '\\' . $d . '\Makefile');
$mf2 =~ s{\\\s*[\r\n]+}{}mg;
$mf2 =~ /^SUBOBJS\s*=\s*(.*)$/gm
|| croak
@ -609,7 +644,8 @@ sub AddContrib
{
my $proj = $solution->AddProject($1, 'exe', 'contrib');
$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;
while ($objs =~ /\b([\w-]+\.o)\b/g)
{
@ -647,7 +683,8 @@ sub GenerateContribSqlFiles
$pcount-- if (substr($l, $i, 1) eq ')');
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)

30
src/tools/msvc/Project.pm
View File

@ -16,8 +16,7 @@ sub _new
my $good_types = {
lib => 1,
exe => 1,
dll => 1,
};
dll => 1, };
confess("Bad project type: $type\n") unless exists $good_types->{$type};
my $self = {
name => $name,
@ -33,8 +32,7 @@ sub _new
solution => $solution,
disablewarnings => '4018;4244;4273;4102;4090;4267',
disablelinkerwarnings => '',
platform => $solution->{platform},
};
platform => $solution->{platform}, };
bless($self, $classname);
return $self;
@ -119,7 +117,8 @@ sub AddReference
while (my $ref = shift)
{
push @{ $self->{references} }, $ref;
$self->AddLibrary("__CFGNAME__\\" . $ref->{name} . "\\" . $ref->{name} . ".lib");
$self->AddLibrary(
"__CFGNAME__\\" . $ref->{name} . "\\" . $ref->{name} . ".lib");
}
}
@ -244,7 +243,8 @@ sub AddDir
next if $f =~ /^\s*$/;
next if $f eq "\\";
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$/;
$f =~ s/\.o$/\.c/;
if ($f =~ /^\$\(top_builddir\)\/(.*)/)
@ -264,7 +264,8 @@ sub AddDir
# Match rules that pull in source files from different directories, eg
# 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)
{
my $match = $1;
@ -305,14 +306,17 @@ sub AddResourceFile
{
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";
if (Solution::IsNewer("$dir\\win32ver.rc", 'src\port\win32ver.rc'))
{
print "Generating win32ver.rc for $dir\n";
open(I,'src\port\win32ver.rc') || confess "Could not open win32ver.rc";
open(O,">$dir\\win32ver.rc") || confess "Could not write win32ver.rc";
open(I, 'src\port\win32ver.rc')
|| confess "Could not open win32ver.rc";
open(O, ">$dir\\win32ver.rc")
|| confess "Could not write win32ver.rc";
my $icostr = $ico ? "IDI_ICON ICON \"src/port/$ico.ico\"" : "";
while (<I>)
{
@ -335,7 +339,8 @@ sub DisableLinkerWarnings
{
my ($self, $warnings) = @_;
$self->{disablelinkerwarnings} .= ',' unless ($self->{disablelinkerwarnings} eq '');
$self->{disablelinkerwarnings} .= ','
unless ($self->{disablelinkerwarnings} eq '');
$self->{disablelinkerwarnings} .= $warnings;
}
@ -356,7 +361,8 @@ sub Save
# Dump the project
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->WriteFiles(*F);
$self->Footer(*F);

132
src/tools/msvc/Solution.pm
View File

@ -20,8 +20,7 @@ sub _new
numver => '',
strver => '',
vcver => undef,
platform => undef,
};
platform => undef, };
bless($self, $classname);
# integer_datetimes is now the default
@ -48,7 +47,8 @@ sub _new
$options->{wal_blocksize} = 8
unless $options->{wal_blocksize}; # undef or 0 means default
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
unless $options->{wal_segsize}; # undef or 0 means default
die "Bad wal_segsize $options->{wal_segsize}"
@ -121,7 +121,8 @@ sub GenerateFiles
my $bits = $self->{platform} eq 'Win32' ? 32 : 64;
# 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>)
{
if (/^AC_INIT\(\[PostgreSQL\], \[([^\]]+)\]/)
@ -139,18 +140,22 @@ sub GenerateFiles
confess "Unable to parse configure.in for all variables!"
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";
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";
open(I, "src\\include\\pg_config.h.win32")
|| 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>)
{
s{PG_VERSION "[^"]+"}{PG_VERSION "$self->{strver}"};
@ -159,10 +164,12 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
print O;
}
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 "#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"
if ($self->{options}->{integer_datetimes});
print O "#define USE_LDAP 1\n" if ($self->{options}->{ldap});
@ -172,8 +179,11 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
print O "#define BLCKSZ ", 1024 * $self->{options}->{blocksize}, "\n";
print O "#define RELSEG_SIZE ",
(1024 / $self->{options}->{blocksize}) *$self->{options}->{segsize} * 1024, "\n";
print O "#define XLOG_BLCKSZ ",1024 * $self->{options}->{wal_blocksize},"\n";
(1024 / $self->{options}->{blocksize}) *
$self->{options}->{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";
@ -225,37 +235,40 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
print O "#define DEF_PGPORT $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";
close(O);
close(I);
}
$self->GenerateDefFile("src\\interfaces\\libpq\\libpqdll.def",
"src\\interfaces\\libpq\\exports.txt","LIBPQ");
$self->GenerateDefFile(
"src\\interfaces\\libpq\\libpqdll.def",
"src\\interfaces\\libpq\\exports.txt",
"LIBPQ");
$self->GenerateDefFile(
"src\\interfaces\\ecpg\\ecpglib\\ecpglib.def",
"src\\interfaces\\ecpg\\ecpglib\\exports.txt",
"LIBECPG"
);
"LIBECPG");
$self->GenerateDefFile(
"src\\interfaces\\ecpg\\compatlib\\compatlib.def",
"src\\interfaces\\ecpg\\compatlib\\exports.txt",
"LIBECPG_COMPAT"
);
"LIBECPG_COMPAT");
$self->GenerateDefFile(
"src\\interfaces\\ecpg\\pgtypeslib\\pgtypeslib.def",
"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";
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('..\..\..');
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'))
@ -267,7 +280,9 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
}
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";
system(
@ -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";
system(
'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";
system(
@ -292,12 +312,9 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
);
}
if (
IsNewer(
if (IsNewer(
'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";
system(
@ -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";
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";
open(I, '<', 'src\interfaces\libpq\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>)
{
s/(VERSION.*),0/$1,$d/;
@ -330,7 +351,9 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
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";
chdir('src\interfaces\ecpg\preproc');
@ -338,12 +361,9 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
chdir('..\..\..\..');
}
if (
IsNewer(
if (IsNewer(
'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";
open(O, '>', 'src\interfaces\ecpg\include\ecpg_config.h')
@ -389,7 +409,9 @@ EOF
foreach my $bki (@allbki)
{
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";
chdir('src\backend\catalog');
@ -398,13 +420,15 @@ EOF
"perl genbki.pl -I../../../src/include/catalog --set-version=$self->{majorver} $bki_srcs"
);
chdir('..\..\..');
copyFile('src\backend\catalog\schemapg.h',
copyFile(
'src\backend\catalog\schemapg.h',
'src\include\catalog\schemapg.h');
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;
<!ENTITY version "$self->{strver}">
<!ENTITY majorversion "$self->{majorver}">
@ -438,7 +462,8 @@ sub AddProject
{
my ($self, $name, $type, $folder, $initialdir) = @_;
my $proj = VSObjectFactory::CreateProject($self->{vcver}, $name, $type, $self);
my $proj =
VSObjectFactory::CreateProject($self->{vcver}, $name, $type, $self);
push @{ $self->{projects}->{$folder} }, $proj;
$proj->AddDir($initialdir) if ($initialdir);
if ($self->{options}->{zlib})
@ -449,8 +474,10 @@ sub AddProject
if ($self->{options}->{openssl})
{
$proj->AddIncludeDir($self->{options}->{openssl} . '\include');
$proj->AddLibrary($self->{options}->{openssl} . '\lib\VC\ssleay32.lib', 1);
$proj->AddLibrary($self->{options}->{openssl} . '\lib\VC\libeay32.lib', 1);
$proj->AddLibrary(
$self->{options}->{openssl} . '\lib\VC\ssleay32.lib', 1);
$proj->AddLibrary(
$self->{options}->{openssl} . '\lib\VC\libeay32.lib', 1);
}
if ($self->{options}->{nls})
{
@ -461,8 +488,10 @@ sub AddProject
{
$proj->AddIncludeDir($self->{options}->{krb5} . '\inc\krb5');
$proj->AddLibrary($self->{options}->{krb5} . '\lib\i386\krb5_32.lib');
$proj->AddLibrary($self->{options}->{krb5} . '\lib\i386\comerr32.lib');
$proj->AddLibrary($self->{options}->{krb5} . '\lib\i386\gssapi32.lib');
$proj->AddLibrary(
$self->{options}->{krb5} . '\lib\i386\comerr32.lib');
$proj->AddLibrary(
$self->{options}->{krb5} . '\lib\i386\gssapi32.lib');
}
if ($self->{options}->{iconv})
{
@ -573,7 +602,8 @@ sub GetFakeConfigure
my $cfg = '--enable-thread-safety';
$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 .= ' --with-ldap' if ($self->{options}->{ldap});
$cfg .= ' --without-zlib' unless ($self->{options}->{zlib});

46
src/tools/msvc/VCBuildProject.pm
View File

@ -32,10 +32,21 @@ sub WriteHeader
<Platforms><Platform Name="$self->{platform}"/></Platforms>
<Configurations>
EOF
$self->WriteConfiguration($f, 'Debug',
{defs=>'_DEBUG;DEBUG=1;', wholeopt=>0, opt=>0, strpool=>'false', runtime=>3});
$self->WriteConfiguration($f, 'Release',
{defs=>'', wholeopt=>0, opt=>3, strpool=>'true', runtime=>2});
$self->WriteConfiguration(
$f, 'Debug',
{ defs => '_DEBUG;DEBUG=1;',
wholeopt => 0,
opt => 0,
strpool => 'false',
runtime => 3 });
$self->WriteConfiguration(
$f,
'Release',
{ defs => '',
wholeopt => 0,
opt => 3,
strpool => 'true',
runtime => 2 });
print $f <<EOF;
</Configurations>
EOF
@ -60,10 +71,12 @@ EOF
# Walk backwards down the directory stack and close any dirs we're done with
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 (substr($dir, length(join('\\',@dirstack)),1) eq '\\');
last
if (substr($dir, length(join('\\', @dirstack)), 1) eq '\\');
}
print $f ' ' x $#dirstack . " </Filter>\n";
pop @dirstack;
@ -76,17 +89,21 @@ EOF
$left =~ s/^\\//;
my @pieces = split /\\/, $left;
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$/)
{
my $of = $fileNameWithPath;
$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 '>'
. $self->GenerateCustomTool('Running bison on ' . $fileNameWithPath,
. $self->GenerateCustomTool(
'Running bison on ' . $fileNameWithPath,
"perl src\\tools\\msvc\\pgbison.pl $fileNameWithPath", $of)
. '</File>' . "\n";
}
@ -95,7 +112,8 @@ EOF
my $of = $fileNameWithPath;
$of =~ s/\.l$/.c/;
print $f '>'
. $self->GenerateCustomTool('Running flex on ' . $fileNameWithPath,
. $self->GenerateCustomTool(
'Running flex on ' . $fileNameWithPath,
"perl src\\tools\\msvc\\pgflex.pl $fileNameWithPath", $of)
. '</File>' . "\n";
}
@ -139,7 +157,8 @@ EOF
sub WriteConfiguration
{
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 $targetmachine = $self->{platform} eq 'Win32' ? 1 : 17;
@ -168,7 +187,8 @@ EOF
EOF
if ($self->{disablelinkerwarnings})
{
print $f "\t\tAdditionalOptions=\"/ignore:$self->{disablelinkerwarnings}\"\n";
print $f
"\t\tAdditionalOptions=\"/ignore:$self->{disablelinkerwarnings}\"\n";
}
if ($self->{implib})
{

3
src/tools/msvc/build.pl
View File

@ -52,7 +52,8 @@ elsif ($ARGV[0] ne "RELEASE")
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)
{

13
src/tools/msvc/builddoc.pl
View File

@ -35,7 +35,8 @@ renamefiles();
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;
@ -56,7 +57,8 @@ $cmd =
. "> features-unsupported.sgml";
system($cmd);
die "features_unsupported" if $?;
$cmd ="perl generate-errcodes-table.pl \"../../../src/backend/utils/errcodes.txt\" "
$cmd =
"perl generate-errcodes-table.pl \"../../../src/backend/utils/errcodes.txt\" "
. "> errcodes-table.sgml";
system($cmd);
die "errcodes-table" if $?;
@ -69,8 +71,8 @@ $cmd =
. "| findstr /V \"DTDDECL catalog entries are not supported\" ";
system($cmd); # die "openjade" if $?;
print "Running collateindex...\n";
$cmd =
"perl \"$docroot/$dsssl/bin/collateindex.pl\" -f -g -i bookindex "."-o bookindex.sgml HTML.index";
$cmd = "perl \"$docroot/$dsssl/bin/collateindex.pl\" -f -g -i bookindex "
. "-o bookindex.sgml HTML.index";
system($cmd);
die "collateindex" if $?;
mkdir "html";
@ -116,6 +118,7 @@ sub missing
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;
}

9
src/tools/msvc/gendef.pl
View File

@ -7,7 +7,8 @@ my @def;
#
die "Usage: gendef.pl <modulepath> <platform>\n"
unless(($ARGV[0] =~ /\\([^\\]+$)/) && ($ARGV[1] == 'Win32' || $ARGV[1] == 'x64'));
unless (($ARGV[0] =~ /\\([^\\]+$)/)
&& ($ARGV[1] == 'Win32' || $ARGV[1] == 'x64'));
my $defname = uc $1;
my $platform = $ARGV[1];
@ -24,7 +25,8 @@ while (<$ARGV[0]/*.obj>)
my $symfile = $_;
$symfile =~ s/\.obj$/.sym/i;
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";
while (<F>)
{
@ -58,7 +60,8 @@ foreach my $f (sort @def)
{
next if ($f eq $last);
$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++;
# print DEF " $f \@ $i\n"; # ordinaled exports?

9
src/tools/msvc/mkvcbuild.pl
View File

@ -10,10 +10,13 @@ use warnings;
use Mkvcbuild;
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');
print "Warning: no config.pl found, using default.\n" unless (-f 'src/tools/msvc/config.pl');
die 'Could not find config_default.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;
require 'src/tools/msvc/config_default.pl';

48
src/tools/msvc/vcregress.pl
View File

@ -26,7 +26,8 @@ if (-e "src/tools/msvc/buildenv.pl")
}
my $what = shift || "";
if ($what =~ /^(check|installcheck|plcheck|contribcheck|ecpgcheck|isolationcheck)$/i)
if ($what =~
/^(check|installcheck|plcheck|contribcheck|ecpgcheck|isolationcheck)$/i)
{
$what = uc $what;
}
@ -72,8 +73,7 @@ my %command = (
INSTALLCHECK => \&installcheck,
ECPGCHECK => \&ecpgcheck,
CONTRIBCHECK => \&contribcheck,
ISOLATIONCHECK => \&isolationcheck,
);
ISOLATIONCHECK => \&isolationcheck,);
my $proc = $command{$what};
@ -88,10 +88,12 @@ exit 0;
sub installcheck
{
my @args = (
"../../../$Config/pg_regress/pg_regress","--dlpath=.",
"--psqldir=../../../$Config/psql","--schedule=${schedule}_schedule",
"--encoding=SQL_ASCII","--no-locale"
);
"../../../$Config/pg_regress/pg_regress",
"--dlpath=.",
"--psqldir=../../../$Config/psql",
"--schedule=${schedule}_schedule",
"--encoding=SQL_ASCII",
"--no-locale");
push(@args, $maxconn) if $maxconn;
system(@args);
my $status = $? >> 8;
@ -101,11 +103,14 @@ sub installcheck
sub check
{
my @args = (
"../../../$Config/pg_regress/pg_regress","--dlpath=.",
"--psqldir=../../../$Config/psql","--schedule=${schedule}_schedule",
"--encoding=SQL_ASCII","--no-locale",
"--temp-install=./tmp_check","--top-builddir=\"$topdir\""
);
"../../../$Config/pg_regress/pg_regress",
"--dlpath=.",
"--psqldir=../../../$Config/psql",
"--schedule=${schedule}_schedule",
"--encoding=SQL_ASCII",
"--no-locale",
"--temp-install=./tmp_check",
"--top-builddir=\"$topdir\"");
push(@args, $maxconn) if $maxconn;
push(@args, $temp_config) if $temp_config;
system(@args);
@ -130,8 +135,7 @@ sub ecpgcheck
"--encoding=SQL_ASCII",
"--no-locale",
"--temp-install=./tmp_chk",
"--top-builddir=\"$topdir\""
);
"--top-builddir=\"$topdir\"");
push(@args, $maxconn) if $maxconn;
system(@args);
$status = $? >> 8;
@ -145,8 +149,8 @@ sub isolationcheck
my @args = (
"../../../$Config/pg_isolation_regress/pg_isolation_regress",
"--psqldir=../../../$Config/psql",
"--inputdir=.","--schedule=./isolation_schedule"
);
"--inputdir=.",
"--schedule=./isolation_schedule");
push(@args, $maxconn) if $maxconn;
system(@args);
my $status = $? >> 8;
@ -181,13 +185,13 @@ sub plcheck
push(@tests, 'plperl_plperlu');
}
}
print "============================================================\n";
print
"============================================================\n";
print "Checking $lang\n";
my @args = (
"../../../$Config/pg_regress/pg_regress",
"--psqldir=../../../$Config/psql",
"--dbname=pl_regression",@lang_args,@tests
);
"--dbname=pl_regression", @lang_args, @tests);
system(@args);
my $status = $? >> 8;
exit $status if $status;
@ -210,15 +214,15 @@ sub contribcheck
&& -d "$module/expected"
&& (-f "$module/GNUmakefile" || -f "$module/Makefile");
chdir $module;
print "============================================================\n";
print
"============================================================\n";
print "Checking $module\n";
my @tests = fetchTests();
my @opts = fetchRegressOpts();
my @args = (
"../../$Config/pg_regress/pg_regress",
"--psqldir=../../$Config/psql",
"--dbname=contrib_regression",@opts,@tests
);
"--dbname=contrib_regression", @opts, @tests);
system(@args);
my $status = $? >> 8;
$mstat ||= $status;

72
src/tools/version_stamp.pl
View File

@ -29,30 +29,44 @@ $major2 = 2;
$minor = shift;
defined($minor) || die "$0: missing required argument: minor-version\n";
if ($minor =~ m/^\d+$/) {
if ($minor =~ m/^\d+$/)
{
$dotneeded = 1;
$numericminor = $minor;
} elsif ($minor eq "devel") {
}
elsif ($minor eq "devel")
{
$dotneeded = 0;
$numericminor = 0;
} elsif ($minor =~ m/^alpha\d+$/) {
}
elsif ($minor =~ m/^alpha\d+$/)
{
$dotneeded = 0;
$numericminor = 0;
} elsif ($minor =~ m/^beta\d+$/) {
}
elsif ($minor =~ m/^beta\d+$/)
{
$dotneeded = 0;
$numericminor = 0;
} elsif ($minor =~ m/^rc\d+$/) {
}
elsif ($minor =~ m/^rc\d+$/)
{
$dotneeded = 0;
$numericminor = 0;
} else {
}
else
{
die "$0: minor-version must be N, devel, alphaN, betaN, or rcN\n";
}
# Create various required forms of the version number
$majorversion = $major1 . "." . $major2;
if ($dotneeded) {
if ($dotneeded)
{
$fullversion = $majorversion . "." . $minor;
} else {
}
else
{
$fullversion = $majorversion . $minor;
}
$numericversion = $majorversion . "." . $numericminor;
@ -63,47 +77,57 @@ $padnumericversion = sprintf("%d%02d%02d", $major1, $major2, $numericminor);
$aconfver = "";
open(FILE, "configure.in") || die "could not read configure.in: $!\n";
while (<FILE>) {
if (m/^m4_if\(m4_defn\(\[m4_PACKAGE_VERSION\]\), \[(.*)\], \[\], \[m4_fatal/) {
while (<FILE>)
{
if (
m/^m4_if\(m4_defn\(\[m4_PACKAGE_VERSION\]\), \[(.*)\], \[\], \[m4_fatal/)
{
$aconfver = $1;
last;
}
}
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
$fixedfiles = "";
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",
"-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",
"-e 's/#define PACKAGE_STRING \"PostgreSQL .*\"/#define PACKAGE_STRING \"PostgreSQL $fullversion\"/' " .
"-e 's/#define PACKAGE_VERSION \".*\"/#define PACKAGE_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 PACKAGE_STRING \"PostgreSQL .*\"/#define PACKAGE_STRING \"PostgreSQL $fullversion\"/' "
. "-e 's/#define PACKAGE_VERSION \".*\"/#define PACKAGE_VERSION \"$fullversion\"/' "
. "-e 's/#define PG_VERSION \".*\"/#define PG_VERSION \"$fullversion\"/' "
. "-e 's/#define PG_VERSION_NUM .*/#define PG_VERSION_NUM $padnumericversion/'"
);
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/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 \"ProductVersion\", \"[0-9.]*/VALUE \"ProductVersion\", \"$numericversion/'");
"-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/VALUE \"FileVersion\", \"[0-9.]*/VALUE \"FileVersion\", \"$numericversion/' "
. "-e 's/VALUE \"ProductVersion\", \"[0-9.]*/VALUE \"ProductVersion\", \"$numericversion/'"
);
sed_file("src/port/win32ver.rc",
"-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/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/'"
);
print "Stamped these files with version number $fullversion:\n$fixedfiles";
print "Don't forget to run autoconf $aconfver before committing.\n";
exit 0;
sub sed_file {
sub sed_file
{
my ($filename, $sedargs) = @_;
my ($tmpfilename) = $filename . ".tmp";

21
src/tools/win32tzlist.pl
View File

@ -26,7 +26,8 @@ my $tzfile = 'src/bin/initdb/findtimezone.c';
# Fetch all timezones in the registry
#
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 $!;
my @subkeys;
@ -46,11 +47,9 @@ foreach my $keyname (@subkeys)
die "Incomplete timezone data for $keyname!\n"
unless ($vals{Std} && $vals{Dlt} && $vals{Display});
push @system_zones,
{
'std'=>$vals{Std}->[2],
{ 'std' => $vals{Std}->[2],
'dlt' => $vals{Dlt}->[2],
'display'=>clean_displayname($vals{Display}->[2]),
};
'display' => clean_displayname($vals{Display}->[2]), };
}
$basekey->Close();
@ -72,15 +71,14 @@ $pgtz =~ /win32_tzmap\[\] =\s+{\s+\/\*[^\/]+\*\/\s+(.+?)};/gs
$pgtz = $1;
# 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,
{
'std'=>$1,
{ 'std' => $1,
'dlt' => $2,
'match' => $3,
'display'=>clean_displayname($4),
};
'display' => clean_displayname($4), };
}
#
@ -98,7 +96,8 @@ for my $sys (@system_zones)
$match = 1;
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})
{