From 042d9ffc282a8c796d2a5babc600c1a6db150dac Mon Sep 17 00:00:00 2001 From: Bruce Momjian Date: Wed, 4 Jul 2012 21:47:49 -0400 Subject: [PATCH] Run newly-configured perltidy script on Perl files. Run on HEAD and 9.2. --- contrib/intarray/bench/bench.pl | 112 ++-- contrib/intarray/bench/create_test.pl | 41 +- contrib/seg/seg-validate.pl | 56 +- contrib/seg/sort-segments.pl | 29 +- doc/src/sgml/generate-errcodes-table.pl | 75 +-- doc/src/sgml/generate_history.pl | 59 +- doc/src/sgml/mk_feature_tables.pl | 72 ++- src/backend/catalog/Catalog.pm | 294 +++++----- src/backend/catalog/genbki.pl | 536 +++++++++--------- src/backend/utils/Gen_fmgrtab.pl | 103 ++-- src/backend/utils/generate-errcodes.pl | 35 +- src/backend/utils/mb/Unicode/UCS_to_BIG5.pl | 132 +++-- src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl | 76 ++- .../utils/mb/Unicode/UCS_to_EUC_JIS_2004.pl | 277 +++++---- src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl | 172 +++--- src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl | 76 ++- src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl | 97 ++-- .../utils/mb/Unicode/UCS_to_GB18030.pl | 76 ++- .../utils/mb/Unicode/UCS_to_SHIFT_JIS_2004.pl | 211 ++++--- src/backend/utils/mb/Unicode/UCS_to_SJIS.pl | 121 ++-- src/backend/utils/mb/Unicode/UCS_to_most.pl | 142 +++-- src/backend/utils/mb/Unicode/ucs2utf.pl | 38 +- src/backend/utils/sort/gen_qsort_tuple.pl | 12 +- src/bin/psql/create_help.pl | 171 +++--- src/interfaces/ecpg/preproc/check_rules.pl | 60 +- src/interfaces/ecpg/preproc/parse.pl | 370 ++++++------ src/pl/plperl/plc_perlboot.pl | 132 +++-- src/pl/plperl/plperl_opmask.pl | 35 +- src/pl/plperl/text2macro.pl | 24 +- src/pl/plpgsql/src/generate-plerrcodes.pl | 36 +- src/pl/plpython/generate-spiexceptions.pl | 42 +- src/test/locale/sort-test.pl | 6 +- src/test/performance/runtests.pl | 117 ++-- src/tools/check_bison_recursion.pl | 82 +-- src/tools/check_keywords.pl | 293 ++++++---- src/tools/copyright.pl | 59 +- src/tools/msvc/Install.pm | 270 ++++----- src/tools/msvc/MSBuildProject.pm | 51 +- src/tools/msvc/Mkvcbuild.pm | 321 ++++++----- src/tools/msvc/Project.pm | 92 +-- src/tools/msvc/Solution.pm | 246 ++++---- src/tools/msvc/VCBuildProject.pm | 68 ++- src/tools/msvc/VSObjectFactory.pm | 18 +- src/tools/msvc/build.pl | 9 +- src/tools/msvc/builddoc.pl | 57 +- src/tools/msvc/config_default.pl | 38 +- src/tools/msvc/gendef.pl | 19 +- src/tools/msvc/mkvcbuild.pl | 9 +- src/tools/msvc/pgbison.pl | 8 +- src/tools/msvc/pgflex.pl | 18 +- src/tools/msvc/vcregress.pl | 126 ++-- src/tools/version_stamp.pl | 118 ++-- src/tools/win32tzlist.pl | 109 ++-- 53 files changed, 3253 insertions(+), 2593 deletions(-) diff --git a/contrib/intarray/bench/bench.pl b/contrib/intarray/bench/bench.pl index 4e18624b9c..8746291114 100755 --- a/contrib/intarray/bench/bench.pl +++ b/contrib/intarray/bench/bench.pl @@ -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 <connect('DBI:Pg:dbname='.$opt{d}); +my $dbi = DBI->connect('DBI:Pg:dbname=' . $opt{d}); my %table; my @where; -$table{message}=1; +$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; + $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,48 +70,66 @@ if ( $opt{a} ) { } my $outf; -if ( $opt{c} ) { - $outf = ( $opt{u} ) ? 'count( distinct message.mid )' : 'count( message.mid )'; -} else { - $outf = ( $opt{u} ) ? 'distinct( message.mid )' : 'message.mid'; +if ($opt{c}) +{ + $outf = + ($opt{u}) ? 'count( distinct message.mid )' : 'count( message.mid )'; } -my $sql = "select $outf from ".join(', ', keys %table)." where ".join(' AND ', @where).';'; +else +{ + $outf = ($opt{u}) ? 'distinct( message.mid )' : 'message.mid'; +} +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"); } -my $t0 = [gettimeofday]; -my $count=0; -my $b=$opt{b}; -$b||=1; +my $t0 = [gettimeofday]; +my $count = 0; +my $b = $opt{b}; +$b ||= 1; my @a; -foreach ( 1..$b ) { - @a=exec_sql($dbi,$sql); - $count=$#a; +foreach (1 .. $b) +{ + @a = exec_sql($dbi, $sql); + $count = $#a; } -my $elapsed = tv_interval ( $t0, [gettimeofday]); -if ( $opt{o} ) { - foreach ( @a ) { +my $elapsed = tv_interval($t0, [gettimeofday]); +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 ); -$dbi -> disconnect; +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 { - my ($dbi, $sql, @keys) = @_; - my $sth=$dbi->prepare($sql) || die; - $sth->execute( @keys ) || die; - my $r; - my @row; - while ( defined ( $r=$sth->fetchrow_hashref ) ) { - push @row, $r; - } - $sth->finish; - return @row; +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)) + { + push @row, $r; + } + $sth->finish; + return @row; } diff --git a/contrib/intarray/bench/create_test.pl b/contrib/intarray/bench/create_test.pl index 67394f87b7..1323b31e4d 100755 --- a/contrib/intarray/bench/create_test.pl +++ b/contrib/intarray/bench/create_test.pl @@ -15,28 +15,38 @@ create table message_section_map ( EOT -open(MSG,">message.tmp") || die; -open(MAP,">message_section_map.tmp") || die; +open(MSG, ">message.tmp") || die; +open(MAP, ">message_section_map.tmp") || die; + +srand(1); -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 ) { - $sect[0] = int( (rand()**4)*100 ); - } else { - my %hash; - @sect = grep { $hash{$_}++; $hash{$_} <= 1 } map { int( (rand()**4)*100) } 0..( int(rand()*5) ); + if (rand() < 0.7) + { + $sect[0] = int((rand()**4) * 100); } - 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 { - print MSG "$i\t{".join(',',@sect)."}\n"; + } + else + { + print MSG "$i\t{" . join(',', @sect) . "}\n"; map { print MAP "$i\t$_\n" } @sect; } } @@ -64,12 +74,13 @@ EOT unlink 'message.tmp', 'message_section_map.tmp'; -sub copytable { +sub copytable +{ my $t = shift; print "COPY $t from stdin;\n"; - open( FFF, "$t.tmp") || die; - while() { print; } + open(FFF, "$t.tmp") || die; + while () { print; } close FFF; print "\\.\n"; } diff --git a/contrib/seg/seg-validate.pl b/contrib/seg/seg-validate.pl index 9272936aef..cb3fb9a099 100755 --- a/contrib/seg/seg-validate.pl +++ b/contrib/seg/seg-validate.pl @@ -2,12 +2,12 @@ $integer = '[+-]?[0-9]+'; $real = '[+-]?[0-9]+\.[0-9]+'; -$RANGE = '(\.\.)(\.)?'; -$PLUMIN = q(\'\+\-\'); -$FLOAT = "(($integer)|($real))([eE]($integer))?"; +$RANGE = '(\.\.)(\.)?'; +$PLUMIN = q(\'\+\-\'); +$FLOAT = "(($integer)|($real))([eE]($integer))?"; $EXTENSION = '<|>|~'; -$boundary = "($EXTENSION)?$FLOAT"; +$boundary = "($EXTENSION)?$FLOAT"; $deviation = $FLOAT; $rule_1 = $boundary . $PLUMIN . $deviation; @@ -18,25 +18,33 @@ $rule_5 = $boundary; print "$rule_5\n"; -while (<>) { -# s/ +//g; - if ( /^($rule_1)$/ ) { - print; - } - elsif ( /^($rule_2)$/ ) { - print; - } - elsif ( /^($rule_3)$/ ) { - print; - } - elsif ( /^($rule_4)$/ ) { - print; - } - elsif ( /^($rule_5)$/ ) { - print; - } - else { - print STDERR "error in $_\n"; - } +while (<>) +{ + + # s/ +//g; + if (/^($rule_1)$/) + { + print; + } + elsif (/^($rule_2)$/) + { + print; + } + elsif (/^($rule_3)$/) + { + print; + } + elsif (/^($rule_4)$/) + { + print; + } + elsif (/^($rule_5)$/) + { + print; + } + else + { + print STDERR "error in $_\n"; + } } diff --git a/contrib/seg/sort-segments.pl b/contrib/seg/sort-segments.pl index 62cdfb1ffd..a465468d5b 100755 --- a/contrib/seg/sort-segments.pl +++ b/contrib/seg/sort-segments.pl @@ -2,19 +2,22 @@ # this script will sort any table with the segment data type in its last column -while (<>) { - chomp; - push @rows, $_; +while (<>) +{ + chomp; + push @rows, $_; } -foreach ( sort { - @ar = split("\t", $a); - $valA = pop @ar; - $valA =~ s/[~<> ]+//g; - @ar = split("\t", $b); - $valB = pop @ar; - $valB =~ s/[~<> ]+//g; - $valA <=> $valB -} @rows ) { - print "$_\n";; +foreach ( + sort { + @ar = split("\t", $a); + $valA = pop @ar; + $valA =~ s/[~<> ]+//g; + @ar = split("\t", $b); + $valB = pop @ar; + $valB =~ s/[~<> ]+//g; + $valA <=> $valB + } @rows) +{ + print "$_\n"; } diff --git a/doc/src/sgml/generate-errcodes-table.pl b/doc/src/sgml/generate-errcodes-table.pl index e2945747e2..b9c14d3f7d 100644 --- a/doc/src/sgml/generate-errcodes-table.pl +++ b/doc/src/sgml/generate-errcodes-table.pl @@ -6,51 +6,54 @@ use warnings; use strict; -print "\n"; +print + "\n"; open my $errcodes, $ARGV[0] or die; -while (<$errcodes>) { - chomp; +while (<$errcodes>) +{ + chomp; - # Skip comments - next if /^#/; - next if /^\s*$/; + # Skip comments + next if /^#/; + next if /^\s*$/; - # Emit section headers - if (/^Section:/) { + # Emit section headers + if (/^Section:/) + { - # Remove the Section: string - s/^Section: //; - # Escape dashes for SGML - s/-/—/; - # Wrap PostgreSQL in - s/PostgreSQL/PostgreSQL<\/>/g; + # Remove the Section: string + s/^Section: //; - print "\n\n"; + # Escape dashes for SGML + s/-/—/; + + # Wrap PostgreSQL in + s/PostgreSQL/PostgreSQL<\/>/g; + + print "\n\n"; + print "\n"; + print ""; + print "$_\n"; + print "\n"; + + next; + } + + die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/; + + (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); + + print "\n"; print "\n"; - print ""; - print "$_\n"; + print "$sqlstate\n"; + print "$condition_name\n"; print "\n"; - - next; - } - - die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/; - - (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); - - print "\n"; - print "\n"; - print "$sqlstate\n"; - print "$condition_name\n"; - print "\n"; } close $errcodes; diff --git a/doc/src/sgml/generate_history.pl b/doc/src/sgml/generate_history.pl index a6c0bd77c2..1d90c676c7 100644 --- a/doc/src/sgml/generate_history.pl +++ b/doc/src/sgml/generate_history.pl @@ -25,34 +25,41 @@ process_file($infile); exit 0; -sub process_file { - my $filename = shift; +sub process_file +{ + my $filename = shift; - local *FILE; # need a local filehandle so we can recurse + local *FILE; # need a local filehandle so we can recurse - my $f = $srcdir . '/' . $filename; - open(FILE, $f) || die "could not read $f: $!\n"; + my $f = $srcdir . '/' . $filename; + open(FILE, $f) || die "could not read $f: $!\n"; - while () { - # Recursively expand sub-files of the release notes - if (m/^&(release-.*);$/) { - process_file($1 . ".sgml"); - next; + while () + { + + # Recursively expand sub-files of the release notes + if (m/^&(release-.*);$/) + { + process_file($1 . ".sgml"); + next; + } + + # Remove tags, which might span multiple lines + while (m/]*>//) + { + next; + } + + # incomplete tag, so slurp another line + $_ .= ; + } + + # Remove too + s|||g; + + print; } - - # Remove tags, which might span multiple lines - while (m/]*>//) { - next; - } - # incomplete tag, so slurp another line - $_ .= ; - } - - # Remove too - s|||g; - - print; - } - close(FILE); + close(FILE); } diff --git a/doc/src/sgml/mk_feature_tables.pl b/doc/src/sgml/mk_feature_tables.pl index 7c78e0e3aa..45dea798cd 100644 --- a/doc/src/sgml/mk_feature_tables.pl +++ b/doc/src/sgml/mk_feature_tables.pl @@ -8,14 +8,18 @@ open PACK, $ARGV[1] or die; my %feature_packages; -while () { - chomp; - my ($fid, $pname) = split /\t/; - if ($feature_packages{$fid}) { - $feature_packages{$fid} .= ", $pname"; - } else { - $feature_packages{$fid} = $pname; - } +while () +{ + chomp; + my ($fid, $pname) = split /\t/; + if ($feature_packages{$fid}) + { + $feature_packages{$fid} .= ", $pname"; + } + else + { + $feature_packages{$fid} = $pname; + } } close PACK; @@ -24,33 +28,41 @@ open FEAT, $ARGV[2] or die; print "\n"; -while () { - chomp; - my ($feature_id, $feature_name, $subfeature_id, $subfeature_name, $is_supported, $comments) = split /\t/; +while () +{ + chomp; + my ($feature_id, $feature_name, $subfeature_id, + $subfeature_name, $is_supported, $comments) = split /\t/; - $is_supported eq $yesno || next; + $is_supported eq $yesno || next; - $feature_name =~ s//>/g; - $subfeature_name =~ s//>/g; + $feature_name =~ s//>/g; + $subfeature_name =~ s//>/g; - print " \n"; + print " \n"; - if ($subfeature_id) { - print " $feature_id-$subfeature_id\n"; - } else { - print " $feature_id\n"; - } - print " " . $feature_packages{$feature_id} . "\n"; - if ($subfeature_id) { - print " $subfeature_name\n"; - } else { - print " $feature_name\n"; - } - print " $comments\n"; + if ($subfeature_id) + { + print " $feature_id-$subfeature_id\n"; + } + else + { + print " $feature_id\n"; + } + print " " . $feature_packages{$feature_id} . "\n"; + if ($subfeature_id) + { + print " $subfeature_name\n"; + } + else + { + print " $feature_name\n"; + } + print " $comments\n"; - print " \n"; + print " \n"; } print "\n"; diff --git a/src/backend/catalog/Catalog.pm b/src/backend/catalog/Catalog.pm index 0be29e304e..ebc02b50a9 100644 --- a/src/backend/catalog/Catalog.pm +++ b/src/backend/catalog/Catalog.pm @@ -25,152 +25,160 @@ our @EXPORT_OK = qw(Catalogs RenameTempFile); # Returns a nested data structure describing the data in the headers. sub Catalogs { - my (%catalogs, $catname, $declaring_attributes, $most_recent); - $catalogs{names} = []; + my (%catalogs, $catname, $declaring_attributes, $most_recent); + $catalogs{names} = []; - # There are a few types which are given one name in the C source, but a - # different name at the SQL level. These are enumerated here. - my %RENAME_ATTTYPE = ( - 'int16' => 'int2', - 'int32' => 'int4', - 'Oid' => 'oid', - 'NameData' => 'name', - 'TransactionId' => 'xid' - ); + # There are a few types which are given one name in the C source, but a + # different name at the SQL level. These are enumerated here. + my %RENAME_ATTTYPE = ( + 'int16' => 'int2', + 'int32' => 'int4', + 'Oid' => 'oid', + 'NameData' => 'name', + 'TransactionId' => 'xid'); - foreach my $input_file (@_) - { - my %catalog; - $catalog{columns} = []; - $catalog{data} = []; + foreach my $input_file (@_) + { + my %catalog; + $catalog{columns} = []; + $catalog{data} = []; - open(INPUT_FILE, '<', $input_file) || die "$input_file: $!"; + open(INPUT_FILE, '<', $input_file) || die "$input_file: $!"; - # Scan the input file. - while () - { - # Strip C-style comments. - s;/\*(.|\n)*\*/;;g; - if (m;/\*;) - { - # handle multi-line comments properly. - my $next_line = ; - die "$input_file: ends within C-style comment\n" - if !defined $next_line; - $_ .= $next_line; - redo; - } + # Scan the input file. + while () + { - # Strip useless whitespace and trailing semicolons. - chomp; - s/^\s+//; - s/;\s*$//; - s/\s+/ /g; + # Strip C-style comments. + s;/\*(.|\n)*\*/;;g; + if (m;/\*;) + { - # Push the data into the appropriate data structure. - if (/^DATA\(insert(\s+OID\s+=\s+(\d+))?\s+\(\s*(.*)\s*\)\s*\)$/) - { - push @{ $catalog{data} }, {oid => $2, bki_values => $3}; - } - elsif (/^DESCR\(\"(.*)\"\)$/) - { - $most_recent = $catalog{data}->[-1]; - # this tests if most recent line is not a DATA() statement - if (ref $most_recent ne 'HASH') - { - die "DESCR() does not apply to any catalog ($input_file)"; - } - if (!defined $most_recent->{oid}) - { - die "DESCR() does not apply to any oid ($input_file)"; - } - elsif ($1 ne '') - { - $most_recent->{descr} = $1; - } - } - 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)"; - } - if (!defined $most_recent->{oid}) - { - die "SHDESCR() does not apply to any oid ($input_file)"; - } - elsif ($1 ne '') - { - $most_recent->{shdescr} = $1; - } - } - elsif (/^DECLARE_TOAST\(\s*(\w+),\s*(\d+),\s*(\d+)\)/) - { - $catname = 'toasting'; - my ($toast_name, $toast_oid, $index_oid) = ($1, $2, $3); - push @{ $catalog{data} }, "declare toast $toast_oid $index_oid on $toast_name\n"; - } - elsif (/^DECLARE_(UNIQUE_)?INDEX\(\s*(\w+),\s*(\d+),\s*(.+)\)/) - { - $catname = 'indexing'; - 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 - ); - } - elsif (/^BUILD_INDICES/) - { - push @{ $catalog{data} }, "build indices\n"; - } - elsif (/^CATALOG\(([^,]*),(\d+)\)/) - { - $catname = $1; - $catalog{relation_oid} = $2; + # handle multi-line comments properly. + my $next_line = ; + die "$input_file: ends within C-style comment\n" + if !defined $next_line; + $_ .= $next_line; + redo; + } - # Store pg_* catalog names in the same order we receive them - push @{ $catalogs{names} }, $catname; + # Strip useless whitespace and trailing semicolons. + chomp; + s/^\s+//; + s/;\s*$//; + s/\s+/ /g; - $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{schema_macro} = /BKI_SCHEMA_MACRO/ ? 'True' : ''; - $declaring_attributes = 1; - } - elsif ($declaring_attributes) - { - next if (/^{|^$/); - next if (/^#/); - if (/^}/) - { - undef $declaring_attributes; - } - else - { - my ($atttype, $attname) = split /\s+/, $_; - die "parse error ($input_file)" unless $attname; - if (exists $RENAME_ATTTYPE{$atttype}) - { - $atttype = $RENAME_ATTTYPE{$atttype}; - } - if ($attname =~ /(.*)\[.*\]/) # array attribute - { - $attname = $1; - $atttype .= '[]'; # variable-length only - } - push @{ $catalog{columns} }, {$attname => $atttype}; - } - } - } - $catalogs{$catname} = \%catalog; - close INPUT_FILE; - } - return \%catalogs; + # Push the data into the appropriate data structure. + if (/^DATA\(insert(\s+OID\s+=\s+(\d+))?\s+\(\s*(.*)\s*\)\s*\)$/) + { + push @{ $catalog{data} }, { oid => $2, bki_values => $3 }; + } + elsif (/^DESCR\(\"(.*)\"\)$/) + { + $most_recent = $catalog{data}->[-1]; + + # this tests if most recent line is not a DATA() statement + if (ref $most_recent ne 'HASH') + { + die "DESCR() does not apply to any catalog ($input_file)"; + } + if (!defined $most_recent->{oid}) + { + die "DESCR() does not apply to any oid ($input_file)"; + } + elsif ($1 ne '') + { + $most_recent->{descr} = $1; + } + } + 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)"; + } + if (!defined $most_recent->{oid}) + { + die "SHDESCR() does not apply to any oid ($input_file)"; + } + elsif ($1 ne '') + { + $most_recent->{shdescr} = $1; + } + } + elsif (/^DECLARE_TOAST\(\s*(\w+),\s*(\d+),\s*(\d+)\)/) + { + $catname = 'toasting'; + my ($toast_name, $toast_oid, $index_oid) = ($1, $2, $3); + push @{ $catalog{data} }, + "declare toast $toast_oid $index_oid on $toast_name\n"; + } + elsif (/^DECLARE_(UNIQUE_)?INDEX\(\s*(\w+),\s*(\d+),\s*(.+)\)/) + { + $catname = 'indexing'; + 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); + } + elsif (/^BUILD_INDICES/) + { + push @{ $catalog{data} }, "build indices\n"; + } + elsif (/^CATALOG\(([^,]*),(\d+)\)/) + { + $catname = $1; + $catalog{relation_oid} = $2; + + # Store pg_* catalog names in the same order we receive them + 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{schema_macro} = /BKI_SCHEMA_MACRO/ ? 'True' : ''; + $declaring_attributes = 1; + } + elsif ($declaring_attributes) + { + next if (/^{|^$/); + next if (/^#/); + if (/^}/) + { + undef $declaring_attributes; + } + else + { + my ($atttype, $attname) = split /\s+/, $_; + die "parse error ($input_file)" unless $attname; + if (exists $RENAME_ATTTYPE{$atttype}) + { + $atttype = $RENAME_ATTTYPE{$atttype}; + } + if ($attname =~ /(.*)\[.*\]/) # array attribute + { + $attname = $1; + $atttype .= '[]'; # variable-length only + } + push @{ $catalog{columns} }, { $attname => $atttype }; + } + } + } + $catalogs{$catname} = \%catalog; + close INPUT_FILE; + } + return \%catalogs; } # Rename temporary files to final names. @@ -179,11 +187,11 @@ sub Catalogs # can't use the same temp files sub RenameTempFile { - my $final_name = shift; - my $extension = shift; - my $temp_name = $final_name . $extension; - print "Writing $final_name\n"; - rename($temp_name, $final_name) || die "rename: $temp_name: $!"; + my $final_name = shift; + my $extension = shift; + my $temp_name = $final_name . $extension; + print "Writing $final_name\n"; + rename($temp_name, $final_name) || die "rename: $temp_name: $!"; } 1; diff --git a/src/backend/catalog/genbki.pl b/src/backend/catalog/genbki.pl index ebc4825cf4..5c910a93c1 100644 --- a/src/backend/catalog/genbki.pl +++ b/src/backend/catalog/genbki.pl @@ -27,44 +27,44 @@ my $major_version; # Process command line switches. while (@ARGV) { - my $arg = shift @ARGV; - if ($arg !~ /^-/) - { - push @input_files, $arg; - } - elsif ($arg =~ /^-o/) - { - $output_path = length($arg) > 2 ? substr($arg, 2) : shift @ARGV; - } - elsif ($arg =~ /^-I/) - { - push @include_path, length($arg) > 2 ? substr($arg, 2) : shift @ARGV; - } - elsif ($arg =~ /^--set-version=(.*)$/) - { - $major_version = $1; - die "Version must be in format nn.nn.\n" - if !($major_version =~ /^\d+\.\d+$/); - } - else - { - usage(); - } + my $arg = shift @ARGV; + if ($arg !~ /^-/) + { + push @input_files, $arg; + } + elsif ($arg =~ /^-o/) + { + $output_path = length($arg) > 2 ? substr($arg, 2) : shift @ARGV; + } + elsif ($arg =~ /^-I/) + { + push @include_path, length($arg) > 2 ? substr($arg, 2) : shift @ARGV; + } + elsif ($arg =~ /^--set-version=(.*)$/) + { + $major_version = $1; + die "Version must be in format nn.nn.\n" + if !($major_version =~ /^\d+\.\d+$/); + } + else + { + usage(); + } } # Sanity check arguments. -die "No input files.\n" if !@input_files; +die "No input files.\n" if !@input_files; die "No include path; you must specify -I at least once.\n" if !@include_path; die "--set-version must be specified.\n" if !defined $major_version; # Make sure output_path ends in a slash. if ($output_path ne '' && substr($output_path, -1) ne '/') { - $output_path .= '/'; + $output_path .= '/'; } # Open temp files -my $tmpext = ".tmp$$"; +my $tmpext = ".tmp$$"; my $bkifile = $output_path . 'postgres.bki'; open BKI, '>', $bkifile . $tmpext or die "can't open $bkifile$tmpext: $!"; @@ -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); @@ -103,155 +105,164 @@ my @tables_needing_macros; our @types; # produce output, one catalog at a time -foreach my $catname ( @{ $catalogs->{names} } ) +foreach my $catname (@{ $catalogs->{names} }) { - # .bki CREATE command for this catalog - my $catalog = $catalogs->{$catname}; - print BKI "create $catname $catalog->{relation_oid}" - . $catalog->{shared_relation} - . $catalog->{bootstrap} - . $catalog->{without_oids} - . $catalog->{rowtype_oid}. "\n"; - my %bki_attr; - my @attnames; - foreach my $column ( @{ $catalog->{columns} } ) - { - my ($attname, $atttype) = %$column; - $bki_attr{$attname} = $atttype; - push @attnames, $attname; - } - print BKI " (\n"; - print BKI join " ,\n", map(" $_ = $bki_attr{$_}", @attnames); - print BKI "\n )\n"; + # .bki CREATE command for this catalog + my $catalog = $catalogs->{$catname}; + print BKI "create $catname $catalog->{relation_oid}" + . $catalog->{shared_relation} + . $catalog->{bootstrap} + . $catalog->{without_oids} + . $catalog->{rowtype_oid} . "\n"; - # open it, unless bootstrap case (create bootstrap does this automatically) - if ($catalog->{bootstrap} eq '') - { - print BKI "open $catname\n"; - } + my %bki_attr; + my @attnames; + foreach my $column (@{ $catalog->{columns} }) + { + my ($attname, $atttype) = %$column; + $bki_attr{$attname} = $atttype; + push @attnames, $attname; + } + print BKI " (\n"; + print BKI join " ,\n", map(" $_ = $bki_attr{$_}", @attnames); + print BKI "\n )\n"; - 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; + # open it, unless bootstrap case (create bootstrap does this automatically) + if ($catalog->{bootstrap} eq '') + { + print BKI "open $catname\n"; + } - # Save pg_type info for pg_attribute processing below - if ($catname eq 'pg_type') - { - my %type; - $type{oid} = $row->{oid}; - @type{@attnames} = split /\s+/, $row->{bki_values}; - push @types, \%type; - } + if (defined $catalog->{data}) + { - # Write to postgres.bki - my $oid = $row->{oid} ? "OID = $row->{oid} " : ''; - printf BKI "insert %s( %s)\n", $oid, $row->{bki_values}; + # Ordinary catalog with DATA line(s) + foreach my $row (@{ $catalog->{data} }) + { - # 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}; - } - if (defined $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. - foreach my $table_name ( @{ $catalogs->{names} } ) - { - my $table = $catalogs->{$table_name}; + # 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; - # Currently, all bootstrapped relations also need schemapg.h - # entries, so skip if the relation isn't to be in schemapg.h. - next if $table->{schema_macro} ne 'True'; + # Save pg_type info for pg_attribute processing below + if ($catname eq 'pg_type') + { + my %type; + $type{oid} = $row->{oid}; + @type{@attnames} = split /\s+/, $row->{bki_values}; + push @types, \%type; + } - $schemapg_entries{$table_name} = []; - push @tables_needing_macros, $table_name; - my $is_bootstrap = $table->{bootstrap}; + # Write to postgres.bki + my $oid = $row->{oid} ? "OID = $row->{oid} " : ''; + printf BKI "insert %s( %s)\n", $oid, $row->{bki_values}; - # Generate entries for user attributes. - my $attnum = 0; - my $priornotnull = 1; - my @user_attrs = @{ $table->{columns} }; - foreach my $attr (@user_attrs) - { - $attnum++; - my $row = emit_pgattr_row($table_name, $attr, $priornotnull); - $row->{attnum} = $attnum; - $row->{attstattarget} = '-1'; - $priornotnull &= ($row->{attnotnull} eq 't'); + # 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}; + } + if (defined $row->{shdescr}) + { + printf SHDESCR "%s\t%s\t%s\n", $row->{oid}, $catname, + $row->{shdescr}; + } + } + } + if ($catname eq 'pg_attribute') + { - # If it's bootstrapped, put an entry in postgres.bki. - if ($is_bootstrap eq ' bootstrap') - { - bki_insert($row, @attnames); - } + # For pg_attribute.h, we generate DATA entries ourselves. + # NB: pg_type.h must come before pg_attribute.h in the input list + # of catalog names, since we use info from pg_type.h here. + foreach my $table_name (@{ $catalogs->{names} }) + { + my $table = $catalogs->{$table_name}; - # Store schemapg entries for later. - $row = emit_schemapg_row($row, grep { $bki_attr{$_} eq 'bool' } @attnames); - push @{ $schemapg_entries{$table_name} }, - '{ ' . join(', ', grep { defined $_ } - map $row->{$_}, @attnames) . ' }'; - } + # Currently, all bootstrapped relations also need schemapg.h + # entries, so skip if the relation isn't to be in schemapg.h. + next if $table->{schema_macro} ne 'True'; - # Generate entries for system attributes. - # We only need postgres.bki entries, not schemapg.h entries. - if ($is_bootstrap eq ' bootstrap') - { - $attnum = 0; - my @SYS_ATTRS = ( - {ctid => 'tid'}, - {oid => 'oid'}, - {xmin => 'xid'}, - {cmin => 'cid'}, - {xmax => 'xid'}, - {cmax => 'cid'}, - {tableoid => 'oid'} - ); - foreach my $attr (@SYS_ATTRS) - { - $attnum--; - my $row = emit_pgattr_row($table_name, $attr, 1); - $row->{attnum} = $attnum; - $row->{attstattarget} = '0'; + $schemapg_entries{$table_name} = []; + push @tables_needing_macros, $table_name; + my $is_bootstrap = $table->{bootstrap}; - # some catalogs don't have oids - next if $table->{without_oids} eq ' without_oids' && - $row->{attname} eq 'oid'; + # Generate entries for user attributes. + my $attnum = 0; + my $priornotnull = 1; + my @user_attrs = @{ $table->{columns} }; + foreach my $attr (@user_attrs) + { + $attnum++; + my $row = emit_pgattr_row($table_name, $attr, $priornotnull); + $row->{attnum} = $attnum; + $row->{attstattarget} = '-1'; + $priornotnull &= ($row->{attnotnull} eq 't'); - bki_insert($row, @attnames); - } - } - } - } + # If it's bootstrapped, put an entry in postgres.bki. + if ($is_bootstrap eq ' bootstrap') + { + bki_insert($row, @attnames); + } - print BKI "close $catname\n"; + # Store schemapg entries for later. + $row = + emit_schemapg_row($row, + grep { $bki_attr{$_} eq 'bool' } @attnames); + push @{ $schemapg_entries{$table_name} }, '{ ' + . join( + ', ', grep { defined $_ } + map $row->{$_}, @attnames) . ' }'; + } + + # Generate entries for system attributes. + # We only need postgres.bki entries, not schemapg.h entries. + if ($is_bootstrap eq ' bootstrap') + { + $attnum = 0; + my @SYS_ATTRS = ( + { ctid => 'tid' }, + { oid => 'oid' }, + { xmin => 'xid' }, + { cmin => 'cid' }, + { xmax => 'xid' }, + { cmax => 'cid' }, + { tableoid => 'oid' }); + foreach my $attr (@SYS_ATTRS) + { + $attnum--; + my $row = emit_pgattr_row($table_name, $attr, 1); + $row->{attnum} = $attnum; + $row->{attstattarget} = '0'; + + # some catalogs don't have oids + next + if $table->{without_oids} eq ' without_oids' + && $row->{attname} eq 'oid'; + + bki_insert($row, @attnames); + } + } + } + } + + print BKI "close $catname\n"; } # Any information needed for the BKI that is not contained in a pg_*.h header # (i.e., not contained in a header with a CATALOG() statement) comes here # Write out declare toast/index statements -foreach my $declaration ( @{ $catalogs->{toasting}->{data} } ) +foreach my $declaration (@{ $catalogs->{toasting}->{data} }) { - print BKI $declaration; + print BKI $declaration; } -foreach my $declaration ( @{ $catalogs->{indexing}->{data} } ) +foreach my $declaration (@{ $catalogs->{indexing}->{data} }) { - print BKI $declaration; + print BKI $declaration; } @@ -283,9 +294,9 @@ EOM # Emit schemapg declarations foreach my $table_name (@tables_needing_macros) { - print SCHEMAPG "\n#define Schema_$table_name \\\n"; - print SCHEMAPG join ", \\\n", @{ $schemapg_entries{$table_name} }; - print SCHEMAPG "\n"; + print SCHEMAPG "\n#define Schema_$table_name \\\n"; + print SCHEMAPG join ", \\\n", @{ $schemapg_entries{$table_name} }; + print SCHEMAPG "\n"; } # Closing boilerplate for schemapg.h @@ -298,9 +309,9 @@ close DESCR; close SHDESCR; # Finally, rename the completed files into place. -Catalog::RenameTempFile($bkifile, $tmpext); -Catalog::RenameTempFile($schemafile, $tmpext); -Catalog::RenameTempFile($descrfile, $tmpext); +Catalog::RenameTempFile($bkifile, $tmpext); +Catalog::RenameTempFile($schemafile, $tmpext); +Catalog::RenameTempFile($descrfile, $tmpext); Catalog::RenameTempFile($shdescrfile, $tmpext); exit 0; @@ -314,137 +325,140 @@ exit 0; # columns were all not-null. sub emit_pgattr_row { - my ($table_name, $attr, $priornotnull) = @_; - my ($attname, $atttype) = %$attr; - my %row; + my ($table_name, $attr, $priornotnull) = @_; + my ($attname, $atttype) = %$attr; + my %row; - $row{attrelid} = $catalogs->{$table_name}->{relation_oid}; - $row{attname} = $attname; + $row{attrelid} = $catalogs->{$table_name}->{relation_oid}; + $row{attname} = $attname; - # Adjust type name for arrays: foo[] becomes _foo - # so we can look it up in pg_type - if ($atttype =~ /(.+)\[\]$/) - { - $atttype = '_' . $1; - } + # Adjust type name for arrays: foo[] becomes _foo + # so we can look it up in pg_type + if ($atttype =~ /(.+)\[\]$/) + { + $atttype = '_' . $1; + } - # Copy the type data from pg_type, and add some type-dependent items - foreach my $type (@types) - { - if ( defined $type->{typname} && $type->{typname} eq $atttype ) - { - $row{atttypid} = $type->{oid}; - $row{attlen} = $type->{typlen}; - $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. - if ($priornotnull) - { - $row{attnotnull} = - $type->{typname} eq 'oidvector' ? 't' - : $type->{typname} eq 'int2vector' ? 't' - : $type->{typlen} eq 'NAMEDATALEN' ? 't' - : $type->{typlen} > 0 ? 't' : 'f'; - } - else - { - $row{attnotnull} = 'f'; - } - last; - } - } + # Copy the type data from pg_type, and add some type-dependent items + foreach my $type (@types) + { + if (defined $type->{typname} && $type->{typname} eq $atttype) + { + $row{atttypid} = $type->{oid}; + $row{attlen} = $type->{typlen}; + $row{attbyval} = $type->{typbyval}; + $row{attstorage} = $type->{typstorage}; + $row{attalign} = $type->{typalign}; - # Add in default values for pg_attribute - my %PGATTR_DEFAULTS = ( - attcacheoff => '-1', - atttypmod => '-1', - atthasdef => 'f', - attisdropped => 'f', - attislocal => 't', - attinhcount => '0', - attacl => '_null_', - attoptions => '_null_', - attfdwoptions => '_null_' - ); - return {%PGATTR_DEFAULTS, %row}; + # 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. + if ($priornotnull) + { + $row{attnotnull} = + $type->{typname} eq 'oidvector' ? 't' + : $type->{typname} eq 'int2vector' ? 't' + : $type->{typlen} eq 'NAMEDATALEN' ? 't' + : $type->{typlen} > 0 ? 't' + : 'f'; + } + else + { + $row{attnotnull} = 'f'; + } + last; + } + } + + # Add in default values for pg_attribute + my %PGATTR_DEFAULTS = ( + attcacheoff => '-1', + atttypmod => '-1', + atthasdef => 'f', + attisdropped => 'f', + attislocal => 't', + attinhcount => '0', + attacl => '_null_', + attoptions => '_null_', + attfdwoptions => '_null_'); + return { %PGATTR_DEFAULTS, %row }; } # Write a pg_attribute entry to postgres.bki sub bki_insert { - my $row = shift; - my @attnames = @_; - my $oid = $row->{oid} ? "OID = $row->{oid} " : ''; - my $bki_values = join ' ', map $row->{$_}, @attnames; - printf BKI "insert %s( %s)\n", $oid, $bki_values; + my $row = shift; + my @attnames = @_; + my $oid = $row->{oid} ? "OID = $row->{oid} " : ''; + my $bki_values = join ' ', map $row->{$_}, @attnames; + printf BKI "insert %s( %s)\n", $oid, $bki_values; } # The field values of a Schema_pg_xxx declaration are similar, but not # quite identical, to the corresponding values in postgres.bki. sub emit_schemapg_row { - my $row = shift; - my @bool_attrs = @_; + my $row = shift; + my @bool_attrs = @_; - # Supply appropriate quoting for these fields. - $row->{attname} = q|{"| . $row->{attname} . q|"}|; - $row->{attstorage} = q|'| . $row->{attstorage} . q|'|; - $row->{attalign} = q|'| . $row->{attalign} . q|'|; + # Supply appropriate quoting for these fields. + $row->{attname} = q|{"| . $row->{attname} . q|"}|; + $row->{attstorage} = q|'| . $row->{attstorage} . q|'|; + $row->{attalign} = q|'| . $row->{attalign} . q|'|; - # We don't emit initializers for the variable length fields at all. - # Only the fixed-size portions of the descriptors are ever used. - delete $row->{attacl}; - delete $row->{attoptions}; - delete $row->{attfdwoptions}; + # We don't emit initializers for the variable length fields at all. + # Only the fixed-size portions of the descriptors are ever used. + delete $row->{attacl}; + delete $row->{attoptions}; + delete $row->{attfdwoptions}; - # Expand booleans from 'f'/'t' to 'false'/'true'. - # Some values might be other macros (eg FLOAT4PASSBYVAL), don't change. - foreach my $attr (@bool_attrs) - { - $row->{$attr} = - $row->{$attr} eq 't' ? 'true' - : $row->{$attr} eq 'f' ? 'false' - : $row->{$attr}; - } - return $row; + # Expand booleans from 'f'/'t' to 'false'/'true'. + # Some values might be other macros (eg FLOAT4PASSBYVAL), don't change. + foreach my $attr (@bool_attrs) + { + $row->{$attr} = + $row->{$attr} eq 't' ? 'true' + : $row->{$attr} eq 'f' ? 'false' + : $row->{$attr}; + } + return $row; } # Find a symbol defined in a particular header file and extract the value. 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 '/') - { - $path .= '/'; - } - my $file = $path . $catalog_header; - next if !-f $file; - open(FIND_DEFINED_SYMBOL, '<', $file) || die "$file: $!"; - while () - { - if (/^#define\s+\Q$symbol\E\s+(\S+)/) - { - return $1; - } - } - close FIND_DEFINED_SYMBOL; - die "$file: no definition found for $symbol\n"; - } - die "$catalog_header: not found in any include directory\n"; + my ($catalog_header, $symbol) = @_; + for my $path (@include_path) + { + + # Make sure include path ends in a slash. + if (substr($path, -1) ne '/') + { + $path .= '/'; + } + my $file = $path . $catalog_header; + next if !-f $file; + open(FIND_DEFINED_SYMBOL, '<', $file) || die "$file: $!"; + while () + { + if (/^#define\s+\Q$symbol\E\s+(\S+)/) + { + return $1; + } + } + close FIND_DEFINED_SYMBOL; + die "$file: no definition found for $symbol\n"; + } + die "$catalog_header: not found in any include directory\n"; } sub usage { - die < 2 ? substr($arg, 2) : shift @ARGV; - } - else - { - usage(); - } + my $arg = shift @ARGV; + if ($arg !~ /^-/) + { + $infile = $arg; + } + elsif ($arg =~ /^-o/) + { + $output_path = length($arg) > 2 ? substr($arg, 2) : shift @ARGV; + } + else + { + usage(); + } } # Make sure output_path ends in a slash. if ($output_path ne '' && substr($output_path, -1) ne '/') { - $output_path .= '/'; + $output_path .= '/'; } # Read all the data from the include/catalog files. @@ -50,48 +50,47 @@ my $catalogs = Catalog::Catalogs($infile); # Collect the raw data from pg_proc.h. my @fmgr = (); my @attnames; -foreach my $column ( @{ $catalogs->{pg_proc}->{columns} } ) +foreach my $column (@{ $catalogs->{pg_proc}->{columns} }) { - push @attnames, keys %$column; + push @attnames, keys %$column; } my $data = $catalogs->{pg_proc}->{data}; 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 - # whitespace. We handle this by folding them all to a simple - # "xxx". Fortunately, this script doesn't need to look at any - # fields that might need quoting, so this simple hack is - # sufficient. - $row->{bki_values} =~ s/"[^"]*"/"xxx"/g; - @{$row}{@attnames} = split /\s+/, $row->{bki_values}; - # Select out just the rows for internal-language procedures. - # Note assumption here that INTERNALlanguageId is 12. - next if $row->{prolang} ne '12'; + # 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 + # whitespace. We handle this by folding them all to a simple + # "xxx". Fortunately, this script doesn't need to look at any + # fields that might need quoting, so this simple hack is + # sufficient. + $row->{bki_values} =~ s/"[^"]*"/"xxx"/g; + @{$row}{@attnames} = split /\s+/, $row->{bki_values}; - push @fmgr, - { - oid => $row->{oid}, - strict => $row->{proisstrict}, - retset => $row->{proretset}, - nargs => $row->{pronargs}, - prosrc => $row->{prosrc}, - }; + # Select out just the rows for internal-language procedures. + # Note assumption here that INTERNALlanguageId is 12. + next if $row->{prolang} ne '12'; - # Hack to work around memory leak in some versions of Perl - $row = undef; + push @fmgr, + { oid => $row->{oid}, + strict => $row->{proisstrict}, + retset => $row->{proretset}, + nargs => $row->{pronargs}, + prosrc => $row->{prosrc}, }; + + # Hack to work around memory leak in some versions of Perl + $row = undef; } # Emit headers for both files -my $tmpext = ".tmp$$"; +my $tmpext = ".tmp$$"; my $oidsfile = $output_path . 'fmgroids.h'; -my $tabfile = $output_path . 'fmgrtab.c'; +my $tabfile = $output_path . 'fmgrtab.c'; open H, '>', $oidsfile . $tmpext or die "Could not open $oidsfile$tmpext: $!"; -open T, '>', $tabfile . $tmpext or die "Could not open $tabfile$tmpext: $!"; +open T, '>', $tabfile . $tmpext or die "Could not open $tabfile$tmpext: $!"; print H qq|/*------------------------------------------------------------------------- @@ -160,12 +159,12 @@ qq|/*------------------------------------------------------------------------- # Emit #define's and extern's -- only one per prosrc value my %seenit; -foreach my $s (sort {$a->{oid} <=> $b->{oid}} @fmgr) +foreach my $s (sort { $a->{oid} <=> $b->{oid} } @fmgr) { - next if $seenit{$s->{prosrc}}; - $seenit{$s->{prosrc}} = 1; - print H "#define F_" . uc $s->{prosrc} . " $s->{oid}\n"; - print T "extern Datum $s->{prosrc} (PG_FUNCTION_ARGS);\n"; + next if $seenit{ $s->{prosrc} }; + $seenit{ $s->{prosrc} } = 1; + print H "#define F_" . uc $s->{prosrc} . " $s->{oid}\n"; + print T "extern Datum $s->{prosrc} (PG_FUNCTION_ARGS);\n"; } # Create the fmgr_builtins table @@ -173,10 +172,10 @@ print T "\nconst FmgrBuiltin fmgr_builtins[] = {\n"; my %bmap; $bmap{'t'} = 'true'; $bmap{'f'} = 'false'; -foreach my $s (sort {$a->{oid} <=> $b->{oid}} @fmgr) +foreach my $s (sort { $a->{oid} <=> $b->{oid} } @fmgr) { - print T - " { $s->{oid}, \"$s->{prosrc}\", $s->{nargs}, $bmap{$s->{strict}}, $bmap{$s->{retset}}, $s->{prosrc} },\n"; + print T +" { $s->{oid}, \"$s->{prosrc}\", $s->{nargs}, $bmap{$s->{strict}}, $bmap{$s->{retset}}, $s->{prosrc} },\n"; } # And add the file footers. @@ -198,11 +197,11 @@ close(T); # Finally, rename the completed files into place. Catalog::RenameTempFile($oidsfile, $tmpext); -Catalog::RenameTempFile($tabfile, $tmpext); +Catalog::RenameTempFile($tabfile, $tmpext); sub usage { - die <) { - chomp; +while (<$errcodes>) +{ + chomp; - # Skip comments - next if /^#/; - next if /^\s*$/; + # Skip comments + next if /^#/; + next if /^\s*$/; - # Emit a comment for each section header - if (/^Section:(.*)/) { + # Emit a comment for each section header + 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); + (my $sqlstate, my $errcode_macro) = ($1, $2); - # Split the sqlstate letters - $sqlstate = join ",", split "", $sqlstate; - # And quote them - $sqlstate =~ s/([^,])/'$1'/g; + # Split the sqlstate letters + $sqlstate = join ",", split "", $sqlstate; - print "#define $errcode_macro MAKE_SQLSTATE($sqlstate)\n"; + # And quote them + $sqlstate =~ s/([^,])/'$1'/g; + + print "#define $errcode_macro MAKE_SQLSTATE($sqlstate)\n"; } close $errcodes; diff --git a/src/backend/utils/mb/Unicode/UCS_to_BIG5.pl b/src/backend/utils/mb/Unicode/UCS_to_BIG5.pl index b41e79703b..06d924853f 100755 --- a/src/backend/utils/mb/Unicode/UCS_to_BIG5.pl +++ b/src/backend/utils/mb/Unicode/UCS_to_BIG5.pl @@ -33,68 +33,82 @@ require "ucs2utf.pl"; # $in_file = "BIG5.TXT"; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); reset 'array'; -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $c, $u, $rest ) = split; - $ucs = hex($u); + ($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 "" ){ - printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; + if ($array{$utf} ne "") + { + printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs; next; } $count++; - $array{ $utf } = $code; + $array{$utf} = $code; } } -close( FILE ); +close(FILE); $in_file = "CP950.TXT"; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $c, $u, $rest ) = split; - $ucs = hex($u); + ($c, $u, $rest) = split; + $ucs = hex($u); $code = hex($c); # 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 "" ){ - printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; + if ($array{$utf} ne "") + { + printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs; next; } $count++; - $array{ $utf } = $code; + $array{$utf} = $code; } } -close( FILE ); +close(FILE); $file = lc("utf8_to_big5.map"); -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "static pg_utf_to_local ULmapBIG5[ $count ] = {\n"; -for $index ( sort {$a <=> $b} keys( %array ) ){ - $code = $array{ $index }; +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; } } @@ -107,67 +121,81 @@ close(FILE); # $in_file = "BIG5.TXT"; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); reset 'array'; -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $c, $u, $rest ) = split; - $ucs = hex($u); + ($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 "" ){ - printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; + if ($array{$utf} ne "") + { + printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs; next; } $count++; - $array{ $code } = $utf; + $array{$code} = $utf; } } -close( FILE ); +close(FILE); $in_file = "CP950.TXT"; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $c, $u, $rest ) = split; - $ucs = hex($u); + ($c, $u, $rest) = split; + $ucs = hex($u); $code = hex($c); # 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 "" ){ - printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; + if ($array{$utf} ne "") + { + printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs; next; } $count++; - $array{ $code } = $utf; + $array{$code} = $utf; } } -close( FILE ); +close(FILE); $file = lc("big5_to_utf8.map"); -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "static pg_local_to_utf LUmapBIG5[ $count ] = {\n"; -for $index ( sort {$a <=> $b} keys( %array ) ){ - $utf = $array{ $index }; +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; } } diff --git a/src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl b/src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl index 0aa94c2b27..38c8ccd880 100755 --- a/src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl +++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl @@ -22,43 +22,51 @@ require "ucs2utf.pl"; $in_file = "GB2312.TXT"; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $c, $u, $rest ) = split; - $ucs = hex($u); + ($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 "" ){ - printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; + if ($array{$utf} ne "") + { + printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs; next; } $count++; - $array{ $utf } = ($code | 0x8080); + $array{$utf} = ($code | 0x8080); } } -close( FILE ); +close(FILE); # # first, generate UTF8 --> EUC_CN table # $file = "utf8_to_euc_cn.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "static pg_utf_to_local ULmapEUC_CN[ $count ] = {\n"; -for $index ( sort {$a <=> $b} keys( %array ) ){ - $code = $array{ $index }; +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,39 +79,47 @@ close(FILE); # reset 'array'; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $c, $u, $rest ) = split; - $ucs = hex($u); + ($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 "" ){ - printf STDERR "Warning: duplicate code: %04x\n",$ucs; + if ($array{$code} ne "") + { + printf STDERR "Warning: duplicate code: %04x\n", $ucs; next; } $count++; $code |= 0x8080; - $array{ $code } = $utf; + $array{$code} = $utf; } } -close( FILE ); +close(FILE); $file = "euc_cn_to_utf8.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "static pg_local_to_utf LUmapEUC_CN[ $count ] = {\n"; -for $index ( sort {$a <=> $b} keys( %array ) ){ - $utf = $array{ $index }; +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; } } diff --git a/src/backend/utils/mb/Unicode/UCS_to_EUC_JIS_2004.pl b/src/backend/utils/mb/Unicode/UCS_to_EUC_JIS_2004.pl index 797f825e33..b381aa6572 100755 --- a/src/backend/utils/mb/Unicode/UCS_to_EUC_JIS_2004.pl +++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_JIS_2004.pl @@ -15,89 +15,110 @@ $TEST = 1; $in_file = "euc-jis-2004-std.txt"; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); reset 'array'; reset 'array1'; reset 'comment'; reset 'comment1'; -while($line = ){ - if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/) { - $c = $1; - $u1 = $2; - $u2 = $3; - $rest = "U+" . $u1 . "+" . $u2 . $4; - $code = hex($c); - $ucs = hex($u1); - $utf1 = &ucs2utf($ucs); - $ucs = hex($u2); - $utf2 = &ucs2utf($ucs); - $str = sprintf "%08x%08x", $utf1, $utf2; - $array1{ $str } = $code; - $comment1{ $str } = $rest; +while ($line = ) +{ + if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/) + { + $c = $1; + $u1 = $2; + $u2 = $3; + $rest = "U+" . $u1 . "+" . $u2 . $4; + $code = hex($c); + $ucs = hex($u1); + $utf1 = &ucs2utf($ucs); + $ucs = hex($u2); + $utf2 = &ucs2utf($ucs); + $str = sprintf "%08x%08x", $utf1, $utf2; + $array1{$str} = $code; + $comment1{$str} = $rest; $count1++; next; - } elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/) { - $c = $1; - $u = $2; + } + elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/) + { + $c = $1; + $u = $2; $rest = "U+" . $u . $3; - } else { + } + else + { next; } - $ucs = hex($u); + $ucs = hex($u); $code = hex($c); - $utf = &ucs2utf($ucs); - if( $array{ $utf } ne "" ){ - printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; + $utf = &ucs2utf($ucs); + if ($array{$utf} ne "") + { + printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs; next; } $count++; - $array{ $utf } = $code; - $comment{ $code } = $rest; + $array{$utf} = $code; + $comment{$code} = $rest; } -close( FILE ); +close(FILE); $file = "utf8_to_euc_jis_2004.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "/*\n"; print FILE " * 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 ) ){ - $code = $array{ $index }; +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" ); + open(FILE1, "> $file1") || die("cannot open $file1"); + open(FILE2, "> $file2") || die("cannot open $file2"); - 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--) { - $s = $i * 8; + 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--) + { + $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"; @@ -107,46 +128,62 @@ if ($TEST == 1) { } $file = "utf8_to_euc_jis_2004_combined.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "/*\n"; print FILE " * 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 ) ){ - $code = $array1{ $index }; +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 ) ){ - $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 ($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))) + { $v1 = hex(substr($index, 0, 8)); $v2 = hex(substr($index, 8, 8)); - for ($i = 3; $i >= 0; $i--) { - $s = $i * 8; + for ($i = 3; $i >= 0; $i--) + { + $s = $i * 8; $mask = 0xff << $s; - print FILE1 pack("C", ($v1 & $mask) >> $s) if $v1 & $mask; + print FILE1 pack("C", ($v1 & $mask) >> $s) if $v1 & $mask; print FILE2 pack("C", ($code & $mask) >> $s) if $code & $mask; } - for ($i = 3; $i >= 0; $i--) { - $s = $i * 8; + for ($i = 3; $i >= 0; $i--) + { + $s = $i * 8; $mask = 0xff << $s; print FILE1 pack("C", ($v2 & $mask) >> $s) if $v2 & $mask; } @@ -162,65 +199,78 @@ if ($TEST == 1) { $in_file = "euc-jis-2004-std.txt"; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); reset 'array'; reset 'array1'; reset 'comment'; reset 'comment1'; -while($line = ){ - if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/) { - $c = $1; - $u1 = $2; - $u2 = $3; - $rest = "U+" . $u1 . "+" . $u2 . $4; - $code = hex($c); - $ucs = hex($u1); - $utf1 = &ucs2utf($ucs); - $ucs = hex($u2); - $utf2 = &ucs2utf($ucs); - $str = sprintf "%08x%08x", $utf1, $utf2; - $array1{ $code } = $str; - $comment1{ $code } = $rest; +while ($line = ) +{ + if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/) + { + $c = $1; + $u1 = $2; + $u2 = $3; + $rest = "U+" . $u1 . "+" . $u2 . $4; + $code = hex($c); + $ucs = hex($u1); + $utf1 = &ucs2utf($ucs); + $ucs = hex($u2); + $utf2 = &ucs2utf($ucs); + $str = sprintf "%08x%08x", $utf1, $utf2; + $array1{$code} = $str; + $comment1{$code} = $rest; $count1++; next; - } elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/) { - $c = $1; - $u = $2; + } + elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/) + { + $c = $1; + $u = $2; $rest = "U+" . $u . $3; - } else { + } + else + { next; } - $ucs = hex($u); + $ucs = hex($u); $code = hex($c); - $utf = &ucs2utf($ucs); - if( $array{ $code } ne "" ){ - printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; + $utf = &ucs2utf($ucs); + if ($array{$code} ne "") + { + printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs; next; } $count++; - $array{ $code } = $utf; - $comment{ $utf } = $rest; + $array{$code} = $utf; + $comment{$utf} = $rest; } -close( FILE ); +close(FILE); $file = "euc_jis_2004_to_utf8.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "/*\n"; print FILE " * 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 ) ){ - $code = $array{ $index }; +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}; } } @@ -228,19 +278,26 @@ print FILE "};\n"; close(FILE); $file = "euc_jis_2004_to_utf8_combined.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "/*\n"; print FILE " * 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 ) ){ - $code = $array1{ $index }; +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}; } } diff --git a/src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl b/src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl index 7c1292e3b8..54632f168f 100755 --- a/src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl +++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl @@ -36,102 +36,118 @@ require "ucs2utf.pl"; # $in_file = "JIS0201.TXT"; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); reset 'array'; -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $c, $u, $rest ) = split; - $ucs = hex($u); + ($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 "" ){ - printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; + if ($array{$utf} ne "") + { + printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs; next; } $count++; # add single shift 2 - $array{ $utf } = ($code | 0x8e00); + $array{$utf} = ($code | 0x8e00); } } -close( FILE ); +close(FILE); # # JIS0208 # $in_file = "JIS0208.TXT"; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $s, $c, $u, $rest ) = split; - $ucs = hex($u); + ($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 "" ){ - printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; + if ($array{$utf} ne "") + { + printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs; next; } $count++; - $array{ $utf } = ($code | 0x8080); + $array{$utf} = ($code | 0x8080); } } -close( FILE ); +close(FILE); # # JIS0212 # $in_file = "JIS0212.TXT"; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $c, $u, $rest ) = split; - $ucs = hex($u); + ($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 "" ){ - printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; + if ($array{$utf} ne "") + { + printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs; next; } $count++; - $array{ $utf } = ($code | 0x8f8080); + $array{$utf} = ($code | 0x8f8080); } } -close( FILE ); +close(FILE); # # first, generate UTF8 --> EUC_JP table # $file = "utf8_to_euc_jp.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "static pg_utf_to_local ULmapEUC_JP[ $count ] = {\n"; -for $index ( sort {$a <=> $b} keys( %array ) ){ - $code = $array{ $index }; +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; } } @@ -148,100 +164,116 @@ close(FILE); # $in_file = "JIS0201.TXT"; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); reset 'array'; -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $c, $u, $rest ) = split; - $ucs = hex($u); + ($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 "" ){ - printf STDERR "Warning: duplicate code: %04x\n",$ucs; + if ($array{$code} ne "") + { + printf STDERR "Warning: duplicate code: %04x\n", $ucs; next; } $count++; # add single shift 2 $code |= 0x8e00; - $array{ $code } = $utf; + $array{$code} = $utf; } } -close( FILE ); +close(FILE); # # JIS0208 # $in_file = "JIS0208.TXT"; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $s, $c, $u, $rest ) = split; - $ucs = hex($u); + ($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 "" ){ - printf STDERR "Warning: duplicate code: %04x\n",$ucs; + if ($array{$code} ne "") + { + printf STDERR "Warning: duplicate code: %04x\n", $ucs; next; } $count++; $code |= 0x8080; - $array{ $code } = $utf; + $array{$code} = $utf; } } -close( FILE ); +close(FILE); # # JIS0212 # $in_file = "JIS0212.TXT"; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $c, $u, $rest ) = split; - $ucs = hex($u); + ($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 "" ){ - printf STDERR "Warning: duplicate code: %04x\n",$ucs; + if ($array{$code} ne "") + { + printf STDERR "Warning: duplicate code: %04x\n", $ucs; next; } $count++; $code |= 0x8f8080; - $array{ $code } = $utf; + $array{$code} = $utf; } } -close( FILE ); +close(FILE); $file = "euc_jp_to_utf8.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "static pg_local_to_utf LUmapEUC_JP[ $count ] = {\n"; -for $index ( sort {$a <=> $b} keys( %array ) ){ - $utf = $array{ $index }; +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; } } diff --git a/src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl b/src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl index 6825f5339a..d0b22fcceb 100755 --- a/src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl +++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl @@ -22,43 +22,51 @@ require "ucs2utf.pl"; $in_file = "KSX1001.TXT"; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $c, $u, $rest ) = split; - $ucs = hex($u); + ($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 "" ){ - printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; + if ($array{$utf} ne "") + { + printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs; next; } $count++; - $array{ $utf } = ($code | 0x8080); + $array{$utf} = ($code | 0x8080); } } -close( FILE ); +close(FILE); # # first, generate UTF8 --> EUC_KR table # $file = "utf8_to_euc_kr.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "static pg_utf_to_local ULmapEUC_KR[ $count ] = {\n"; -for $index ( sort {$a <=> $b} keys( %array ) ){ - $code = $array{ $index }; +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,39 +79,47 @@ close(FILE); # reset 'array'; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $c, $u, $rest ) = split; - $ucs = hex($u); + ($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 "" ){ - printf STDERR "Warning: duplicate code: %04x\n",$ucs; + if ($array{$code} ne "") + { + printf STDERR "Warning: duplicate code: %04x\n", $ucs; next; } $count++; $code |= 0x8080; - $array{ $code } = $utf; + $array{$code} = $utf; } } -close( FILE ); +close(FILE); $file = "euc_kr_to_utf8.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "static pg_local_to_utf LUmapEUC_KR[ $count ] = {\n"; -for $index ( sort {$a <=> $b} keys( %array ) ){ - $utf = $array{ $index }; +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; } } diff --git a/src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl b/src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl index dc406dc16c..45cee78ed8 100755 --- a/src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl +++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl @@ -23,53 +23,66 @@ require "ucs2utf.pl"; $in_file = "CNS11643.TXT"; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $c, $u, $rest ) = split; - $ucs = hex($u); + ($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 "" ){ - printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; + 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) { - $array{ $utf } = (($code & 0xffff) | 0x8080); - } else { - $array{ $utf } = (0x8ea00000 + ($plane << 16)) | (($code & 0xffff) | 0x8080); + if ($plane == 1) + { + $array{$utf} = (($code & 0xffff) | 0x8080); + } + else + { + $array{$utf} = + (0x8ea00000 + ($plane << 16)) | (($code & 0xffff) | 0x8080); } } } -close( FILE ); +close(FILE); # # first, generate UTF8 --> EUC_TW table # $file = "utf8_to_euc_tw.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "static pg_utf_to_local ULmapEUC_TW[ $count ] = {\n"; -for $index ( sort {$a <=> $b} keys( %array ) ){ - $code = $array{ $index }; +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; } } @@ -82,50 +95,60 @@ close(FILE); # reset 'array'; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $c, $u, $rest ) = split; - $ucs = hex($u); + ($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 "" ){ - printf STDERR "Warning: duplicate code: %04x\n",$ucs; + 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; + $array{$c} = $utf; $count++; } $c = (0x8ea00000 + ($plane << 16)) | (($code & 0xffff) | 0x8080); - $array{ $c } = $utf; + $array{$c} = $utf; } } -close( FILE ); +close(FILE); $file = "euc_tw_to_utf8.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "static pg_local_to_utf LUmapEUC_TW[ $count ] = {\n"; -for $index ( sort {$a <=> $b} keys( %array ) ){ - $utf = $array{ $index }; +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; } } diff --git a/src/backend/utils/mb/Unicode/UCS_to_GB18030.pl b/src/backend/utils/mb/Unicode/UCS_to_GB18030.pl index 636a9620bd..ef5dd81de7 100755 --- a/src/backend/utils/mb/Unicode/UCS_to_GB18030.pl +++ b/src/backend/utils/mb/Unicode/UCS_to_GB18030.pl @@ -18,28 +18,32 @@ require "ucs2utf.pl"; $in_file = "ISO10646-GB18030.TXT"; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $u, $c, $rest ) = split; - $ucs = hex($u); + ($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 "" ){ - printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; + if ($array{$utf} ne "") + { + printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs; next; } $count++; - $array{ $utf } = $code; + $array{$utf} = $code; } } -close( FILE ); +close(FILE); # @@ -47,15 +51,19 @@ close( FILE ); # $file = "utf8_to_gb18030.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "static pg_utf_to_local ULmapGB18030[ $count ] = {\n"; -for $index ( sort {$a <=> $b} keys( %array ) ){ - $code = $array{ $index }; +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; } } @@ -69,38 +77,46 @@ close(FILE); # reset 'array'; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $u, $c, $rest ) = split; - $ucs = hex($u); + ($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 "" ){ - printf STDERR "Warning: duplicate code: %04x\n",$ucs; + if ($array{$code} ne "") + { + printf STDERR "Warning: duplicate code: %04x\n", $ucs; next; } $count++; - $array{ $code } = $utf; + $array{$code} = $utf; } } -close( FILE ); +close(FILE); $file = "gb18030_to_utf8.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "static pg_local_to_utf LUmapGB18030[ $count ] = {\n"; -for $index ( sort {$a <=> $b} keys( %array ) ){ - $utf = $array{ $index }; +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; } } diff --git a/src/backend/utils/mb/Unicode/UCS_to_SHIFT_JIS_2004.pl b/src/backend/utils/mb/Unicode/UCS_to_SHIFT_JIS_2004.pl index b16cdb3321..40735ed7e2 100755 --- a/src/backend/utils/mb/Unicode/UCS_to_SHIFT_JIS_2004.pl +++ b/src/backend/utils/mb/Unicode/UCS_to_SHIFT_JIS_2004.pl @@ -13,65 +13,80 @@ require "ucs2utf.pl"; $in_file = "sjis-0213-2004-std.txt"; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); reset 'array'; reset 'array1'; reset 'comment'; reset 'comment1'; -while($line = ){ - if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/) { - $c = $1; - $u1 = $2; - $u2 = $3; - $rest = "U+" . $u1 . "+" . $u2 . $4; - $code = hex($c); - $ucs = hex($u1); - $utf1 = &ucs2utf($ucs); - $ucs = hex($u2); - $utf2 = &ucs2utf($ucs); - $str = sprintf "%08x%08x", $utf1, $utf2; - $array1{ $str } = $code; - $comment1{ $str } = $rest; +while ($line = ) +{ + if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/) + { + $c = $1; + $u1 = $2; + $u2 = $3; + $rest = "U+" . $u1 . "+" . $u2 . $4; + $code = hex($c); + $ucs = hex($u1); + $utf1 = &ucs2utf($ucs); + $ucs = hex($u2); + $utf2 = &ucs2utf($ucs); + $str = sprintf "%08x%08x", $utf1, $utf2; + $array1{$str} = $code; + $comment1{$str} = $rest; $count1++; next; - } elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/) { - $c = $1; - $u = $2; + } + elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/) + { + $c = $1; + $u = $2; $rest = "U+" . $u . $3; - } else { + } + else + { next; } - $ucs = hex($u); + $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; + $utf = &ucs2utf($ucs); + if ($array{$utf} ne "") + { + printf STDERR + "Warning: duplicate UTF8: %08x UCS: %04x Shift JIS: %04x\n", $utf, + $ucs, $code; next; } $count++; - $array{ $utf } = $code; - $comment{ $code } = $rest; + $array{$utf} = $code; + $comment{$code} = $rest; } -close( FILE ); +close(FILE); $file = "utf8_to_shift_jis_2004.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "/*\n"; print FILE " * 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 ) ){ - $code = $array{ $index }; +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}; } } @@ -79,19 +94,27 @@ print FILE "};\n"; close(FILE); $file = "utf8_to_shift_jis_2004_combined.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "/*\n"; print FILE " * 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 ) ){ - $code = $array1{ $index }; +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}; } } @@ -102,66 +125,81 @@ close(FILE); $in_file = "sjis-0213-2004-std.txt"; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); reset 'array'; reset 'array1'; reset 'comment'; reset 'comment1'; -while($line = ){ - if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/) { - $c = $1; - $u1 = $2; - $u2 = $3; - $rest = "U+" . $u1 . "+" . $u2 . $4; - $code = hex($c); - $ucs = hex($u1); - $utf1 = &ucs2utf($ucs); - $ucs = hex($u2); - $utf2 = &ucs2utf($ucs); - $str = sprintf "%08x%08x", $utf1, $utf2; - $array1{ $code } = $str; - $comment1{ $code } = $rest; +while ($line = ) +{ + if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/) + { + $c = $1; + $u1 = $2; + $u2 = $3; + $rest = "U+" . $u1 . "+" . $u2 . $4; + $code = hex($c); + $ucs = hex($u1); + $utf1 = &ucs2utf($ucs); + $ucs = hex($u2); + $utf2 = &ucs2utf($ucs); + $str = sprintf "%08x%08x", $utf1, $utf2; + $array1{$code} = $str; + $comment1{$code} = $rest; $count1++; next; - } elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/) { - $c = $1; - $u = $2; + } + elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/) + { + $c = $1; + $u = $2; $rest = "U+" . $u . $3; - } else { + } + else + { next; } - $ucs = hex($u); + $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; - printf STDERR "Previous value: UTF-8: %08x\n", $array{ $utf }; + $utf = &ucs2utf($ucs); + 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; } $count++; - $array{ $code } = $utf; - $comment{ $utf } = $rest; + $array{$code} = $utf; + $comment{$utf} = $rest; } -close( FILE ); +close(FILE); $file = "shift_jis_2004_to_utf8.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "/*\n"; print FILE " * 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 ) ){ - $code = $array{ $index }; +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}; } } @@ -169,19 +207,26 @@ print FILE "};\n"; close(FILE); $file = "shift_jis_2004_to_utf8_combined.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "/*\n"; print FILE " * 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 ) ){ - $code = $array1{ $index }; +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}; } } diff --git a/src/backend/utils/mb/Unicode/UCS_to_SJIS.pl b/src/backend/utils/mb/Unicode/UCS_to_SJIS.pl index 510350e6b5..f93ca7af30 100755 --- a/src/backend/utils/mb/Unicode/UCS_to_SJIS.pl +++ b/src/backend/utils/mb/Unicode/UCS_to_SJIS.pl @@ -22,60 +22,68 @@ require "ucs2utf.pl"; # first generate UTF-8 --> SJIS table $in_file = "CP932.TXT"; -$count = 0; +$count = 0; -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); -while( ){ - chop; - if( /^#/ ){ - next; - } - ( $c, $u, $rest ) = split; - $ucs = hex($u); - $code = hex($c); - if( $code >= 0x80 && $ucs >= 0x0080 ){ - $utf = &ucs2utf($ucs); - if((( $code >= 0xed40 ) - && ( $code <= 0xeefc )) - || (( $code >= 0x8754 ) - &&( $code <= 0x875d )) - || ( $code == 0x878a ) - || ( $code == 0x8782 ) - || ( $code == 0x8784 ) - || ( $code == 0xfa5b ) - || ( $code == 0xfa54 ) - || (( $code >= 0x8790 ) - && ( $code <= 0x8792 )) - || (( $code >= 0x8795 ) - && ( $code <= 0x8797 )) - || (( $code >= 0x879a ) - && ( $code <= 0x879c ))) - { - printf STDERR "Warning: duplicate UTF8 : UCS=0x%04x SJIS=0x%04x\n",$ucs,$code; - next; - } - $count++; - $array{ $utf } = $code; - } +while () +{ + chop; + if (/^#/) + { + next; + } + ($c, $u, $rest) = split; + $ucs = hex($u); + $code = hex($c); + if ($code >= 0x80 && $ucs >= 0x0080) + { + $utf = &ucs2utf($ucs); + if ((($code >= 0xed40) && ($code <= 0xeefc)) + || ( ($code >= 0x8754) + && ($code <= 0x875d)) + || ($code == 0x878a) + || ($code == 0x8782) + || ($code == 0x8784) + || ($code == 0xfa5b) + || ($code == 0xfa54) + || ( ($code >= 0x8790) + && ($code <= 0x8792)) + || ( ($code >= 0x8795) + && ($code <= 0x8797)) + || ( ($code >= 0x879a) + && ($code <= 0x879c))) + { + printf STDERR + "Warning: duplicate UTF8 : UCS=0x%04x SJIS=0x%04x\n", $ucs, + $code; + next; + } + $count++; + $array{$utf} = $code; + } } -close( FILE ); +close(FILE); # # first, generate UTF8 --> SJIS table # $file = "utf8_to_sjis.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "static pg_utf_to_local ULmapSJIS[ $count ] = {\n"; -for $index ( sort {$a <=> $b} keys( %array ) ){ - $code = $array{ $index }; +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; } } @@ -87,37 +95,44 @@ close(FILE); # then generate SJIS --> UTF8 table # -open( FILE, $in_file ) || die( "cannot open $in_file" ); +open(FILE, $in_file) || die("cannot open $in_file"); reset 'array'; $count = 0; -while( ){ +while () +{ chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $c, $u, $rest ) = split; - $ucs = hex($u); + ($c, $u, $rest) = split; + $ucs = hex($u); $code = hex($c); - if( $code >= 0x80 && $ucs >= 0x0080 ){ + if ($code >= 0x80 && $ucs >= 0x0080) + { $utf = &ucs2utf($ucs); $count++; - $array{ $code } = $utf; + $array{$code} = $utf; } } -close( FILE ); +close(FILE); $file = "sjis_to_utf8.map"; -open( FILE, "> $file" ) || die( "cannot open $file" ); +open(FILE, "> $file") || die("cannot open $file"); print FILE "static pg_local_to_utf LUmapSJIS[ $count ] = {\n"; -for $index ( sort {$a <=> $b} keys( %array ) ){ - $utf = $array{ $index }; +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; } } diff --git a/src/backend/utils/mb/Unicode/UCS_to_most.pl b/src/backend/utils/mb/Unicode/UCS_to_most.pl index b67c7943e6..bd031f79a0 100644 --- a/src/backend/utils/mb/Unicode/UCS_to_most.pl +++ b/src/backend/utils/mb/Unicode/UCS_to_most.pl @@ -18,80 +18,88 @@ require "ucs2utf.pl"; %filename = ( - 'WIN866' => 'CP866.TXT', - 'WIN874' => 'CP874.TXT', - 'WIN1250' => 'CP1250.TXT', - 'WIN1251' => 'CP1251.TXT', - 'WIN1252' => 'CP1252.TXT', - 'WIN1253' => 'CP1253.TXT', - 'WIN1254' => 'CP1254.TXT', - 'WIN1255' => 'CP1255.TXT', - 'WIN1256' => 'CP1256.TXT', - 'WIN1257' => 'CP1257.TXT', - 'WIN1258' => 'CP1258.TXT', - 'ISO8859_2' => '8859-2.TXT', - 'ISO8859_3' => '8859-3.TXT', - 'ISO8859_4' => '8859-4.TXT', - 'ISO8859_5' => '8859-5.TXT', - 'ISO8859_6' => '8859-6.TXT', - 'ISO8859_7' => '8859-7.TXT', - 'ISO8859_8' => '8859-8.TXT', - 'ISO8859_9' => '8859-9.TXT', + 'WIN866' => 'CP866.TXT', + 'WIN874' => 'CP874.TXT', + 'WIN1250' => 'CP1250.TXT', + 'WIN1251' => 'CP1251.TXT', + 'WIN1252' => 'CP1252.TXT', + 'WIN1253' => 'CP1253.TXT', + 'WIN1254' => 'CP1254.TXT', + 'WIN1255' => 'CP1255.TXT', + 'WIN1256' => 'CP1256.TXT', + 'WIN1257' => 'CP1257.TXT', + 'WIN1258' => 'CP1258.TXT', + 'ISO8859_2' => '8859-2.TXT', + 'ISO8859_3' => '8859-3.TXT', + 'ISO8859_4' => '8859-4.TXT', + 'ISO8859_5' => '8859-5.TXT', + 'ISO8859_6' => '8859-6.TXT', + 'ISO8859_7' => '8859-7.TXT', + 'ISO8859_8' => '8859-8.TXT', + 'ISO8859_9' => '8859-9.TXT', 'ISO8859_10' => '8859-10.TXT', 'ISO8859_13' => '8859-13.TXT', 'ISO8859_14' => '8859-14.TXT', 'ISO8859_15' => '8859-15.TXT', 'ISO8859_16' => '8859-16.TXT', - 'KOI8R' => 'KOI8-R.TXT', - 'KOI8U' => 'KOI8-U.TXT', - 'GBK' => 'CP936.TXT', - 'UHC' => 'CP949.TXT', - 'JOHAB' => 'JOHAB.TXT', -); + 'KOI8R' => 'KOI8-R.TXT', + 'KOI8U' => 'KOI8-U.TXT', + 'GBK' => 'CP936.TXT', + 'UHC' => 'CP949.TXT', + 'JOHAB' => 'JOHAB.TXT',); @charsets = keys(filename); @charsets = @ARGV if scalar(@ARGV); -foreach $charset (@charsets) { +foreach $charset (@charsets) +{ -# -# first, generate UTF8-> charset table -# - $in_file = $filename{$charset}; + # + # first, generate UTF8-> charset table + # + $in_file = $filename{$charset}; - open( FILE, $in_file ) || die( "cannot open $in_file" ); + open(FILE, $in_file) || die("cannot open $in_file"); reset 'array'; - while( ){ + while () + { chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $c, $u, $rest ) = split; - $ucs = hex($u); + ($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 "" ){ - printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; + if ($array{$utf} ne "") + { + printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs; next; } $count++; - $array{ $utf } = $code; + $array{$utf} = $code; } } - close( FILE ); + close(FILE); $file = lc("utf8_to_${charset}.map"); - open( FILE, "> $file" ) || die( "cannot open $file" ); + open(FILE, "> $file") || die("cannot open $file"); print FILE "static pg_utf_to_local ULmap${charset}[ $count ] = {\n"; - for $index ( sort {$a <=> $b} keys( %array ) ){ - $code = $array{ $index }; + 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; } } @@ -99,42 +107,50 @@ foreach $charset (@charsets) { print FILE "};\n"; close(FILE); -# -# then generate character set code ->UTF8 table -# - open( FILE, $in_file ) || die( "cannot open $in_file" ); + # + # then generate character set code ->UTF8 table + # + open(FILE, $in_file) || die("cannot open $in_file"); reset 'array'; - while( ){ + while () + { chop; - if( /^#/ ){ + if (/^#/) + { next; } - ( $c, $u, $rest ) = split; - $ucs = hex($u); + ($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 "" ){ - printf STDERR "Warning: duplicate UTF8: %04x\n",$ucs; + if ($array{$code} ne "") + { + printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs; next; } $count++; - $array{ $code } = $utf; + $array{$code} = $utf; } } - close( FILE ); + close(FILE); $file = lc("${charset}_to_utf8.map"); - open( FILE, "> $file" ) || die( "cannot open $file" ); + open(FILE, "> $file") || die("cannot open $file"); print FILE "static pg_local_to_utf LUmap${charset}[ $count ] = {\n"; - for $index ( sort {$a <=> $b} keys( %array ) ){ - $utf = $array{ $index }; + 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; } } diff --git a/src/backend/utils/mb/Unicode/ucs2utf.pl b/src/backend/utils/mb/Unicode/ucs2utf.pl index 083dd8ac06..48d2b69616 100644 --- a/src/backend/utils/mb/Unicode/ucs2utf.pl +++ b/src/backend/utils/mb/Unicode/ucs2utf.pl @@ -4,24 +4,32 @@ # src/backend/utils/mb/Unicode/ucs2utf.pl # convert UCS-4 to UTF-8 # -sub ucs2utf { - local($ucs) = @_; +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) | - (((($ucs & 0x3ffff) >> 12) | 0x80) << 16) | - (((($ucs & 0x0fc0) >> 6) | 0x80) << 8) | - (($ucs & 0x003f) | 0x80); - } - return($utf); + } + 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); + } + return ($utf); } 1; diff --git a/src/backend/utils/sort/gen_qsort_tuple.pl b/src/backend/utils/sort/gen_qsort_tuple.pl index 40d55488f1..18dd751b38 100644 --- a/src/backend/utils/sort/gen_qsort_tuple.pl +++ b/src/backend/utils/sort/gen_qsort_tuple.pl @@ -32,16 +32,16 @@ my $CMPPARAMS; emit_qsort_boilerplate(); -$SUFFIX = 'tuple'; -$EXTRAARGS = ', SortTupleComparator cmp_tuple, Tuplesortstate *state'; +$SUFFIX = 'tuple'; +$EXTRAARGS = ', SortTupleComparator cmp_tuple, Tuplesortstate *state'; $EXTRAPARAMS = ', cmp_tuple, state'; -$CMPPARAMS = ', state'; +$CMPPARAMS = ', state'; emit_qsort_implementation(); -$SUFFIX = 'ssup'; -$EXTRAARGS = ', SortSupport ssup'; +$SUFFIX = 'ssup'; +$EXTRAARGS = ', SortSupport ssup'; $EXTRAPARAMS = ', ssup'; -$CMPPARAMS = ', ssup'; +$CMPPARAMS = ', ssup'; print <<'EOM'; #define cmp_ssup(a, b, ssup) \ ApplySortComparator((a)->datum1, (a)->isnull1, \ diff --git a/src/bin/psql/create_help.pl b/src/bin/psql/create_help.pl index be460a7f86..aa384b3044 100644 --- a/src/bin/psql/create_help.pl +++ b/src/bin/psql/create_help.pl @@ -22,15 +22,18 @@ 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!.*/([^/]+)$!) { - $hfilebasename = $1; +if ($hfile =~ m!.*/([^/]+)$!) +{ + $hfilebasename = $1; } -else { - $hfilebasename = $hfile; +else +{ + $hfilebasename = $hfile; } my $define = $hfilebasename; @@ -38,14 +41,13 @@ $define =~ tr/a-z/A-Z/; $define =~ s/\W/_/g; opendir(DIR, $docdir) - or die "$0: could not open documentation source dir '$docdir': $!\n"; + or die "$0: could not open documentation source dir '$docdir': $!\n"; open(HFILE, ">$hfile") - or die "$0: could not open output file '$hfile': $!\n"; + or die "$0: could not open output file '$hfile': $!\n"; open(CFILE, ">$cfile") - or die "$0: could not open output file '$cfile': $!\n"; + or die "$0: could not open output file '$cfile': $!\n"; -print HFILE -"/* +print HFILE "/* * *** Do not change this file by hand. It is automatically * *** 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,71 +91,90 @@ my $maxlen = 0; my %entries; -foreach my $file (sort readdir DIR) { - my (@cmdnames, $cmddesc, $cmdsynopsis); - $file =~ /\.sgml$/ or next; +foreach my $file (sort readdir DIR) +{ + my (@cmdnames, $cmddesc, $cmdsynopsis); + $file =~ /\.sgml$/ or next; - open(FILE, "$docdir/$file") or next; - my $filecontent = join('', ); - close FILE; + open(FILE, "$docdir/$file") or next; + my $filecontent = join('', ); + close FILE; - # Ignore files that are not for SQL language statements - $filecontent =~ m!\s*SQL - Language Statements\s*!i - or next; + # Ignore files that are not for SQL language statements + $filecontent =~ + m!\s*SQL - Language Statements\s*!i + or next; - # Collect multiple refnames - LOOP: { $filecontent =~ m!\G.*?\s*([a-z ]+?)\s*!cgis and push @cmdnames, $1 and redo LOOP; } - $filecontent =~ m!\s*(.+?)\s*!is and $cmddesc = $1; - $filecontent =~ m!\s*(.+?)\s*!is and $cmdsynopsis = $1; - - if (@cmdnames && $cmddesc && $cmdsynopsis) { - s/\"/\\"/g foreach @cmdnames; - - $cmddesc =~ s/<[^>]+>//g; - $cmddesc =~ s/\s+/ /g; - $cmddesc =~ s/\"/\\"/g; - - my @params = (); - - my $nl_count = () = $cmdsynopsis =~ /\n/g; - - $cmdsynopsis =~ m!! and die "$0:$file: null end tag not supported in synopsis\n"; - $cmdsynopsis =~ s/%/%%/g; - - while ($cmdsynopsis =~ m!<(\w+)[^>]*>(.+?)]*>!) { - my $match = $2; - $match =~ s/<[^>]+>//g; - $match =~ s/%%/%/g; - push @params, $match; - $cmdsynopsis =~ s!<(\w+)[^>]*>.+?]*>!%s!; - } - $cmdsynopsis =~ s/\r?\n/\\n/g; - $cmdsynopsis =~ s/\"/\\"/g; - - foreach my $cmdname (@cmdnames) { - $entries{$cmdname} = { cmddesc => $cmddesc, cmdsynopsis => $cmdsynopsis, params => \@params, nl_count => $nl_count }; - $maxlen = ($maxlen >= length $cmdname) ? $maxlen : length $cmdname; + # Collect multiple refnames + LOOP: + { + $filecontent =~ m!\G.*?\s*([a-z ]+?)\s*!cgis + and push @cmdnames, $1 + and redo LOOP; + } + $filecontent =~ m!\s*(.+?)\s*!is + and $cmddesc = $1; + $filecontent =~ m!\s*(.+?)\s*!is + and $cmdsynopsis = $1; + + if (@cmdnames && $cmddesc && $cmdsynopsis) + { + s/\"/\\"/g foreach @cmdnames; + + $cmddesc =~ s/<[^>]+>//g; + $cmddesc =~ s/\s+/ /g; + $cmddesc =~ s/\"/\\"/g; + + my @params = (); + + my $nl_count = () = $cmdsynopsis =~ /\n/g; + + $cmdsynopsis =~ m!! + and die "$0:$file: null end tag not supported in synopsis\n"; + $cmdsynopsis =~ s/%/%%/g; + + while ($cmdsynopsis =~ m!<(\w+)[^>]*>(.+?)]*>!) + { + my $match = $2; + $match =~ s/<[^>]+>//g; + $match =~ s/%%/%/g; + push @params, $match; + $cmdsynopsis =~ s!<(\w+)[^>]*>.+?]*>!%s!; + } + $cmdsynopsis =~ s/\r?\n/\\n/g; + $cmdsynopsis =~ s/\"/\\"/g; + + foreach my $cmdname (@cmdnames) + { + $entries{$cmdname} = { + cmddesc => $cmddesc, + cmdsynopsis => $cmdsynopsis, + params => \@params, + nl_count => $nl_count }; + $maxlen = + ($maxlen >= length $cmdname) ? $maxlen : length $cmdname; + } + } + else + { + die "$0: parsing file '$file' failed (N='@cmdnames' D='$cmddesc')\n"; } - } - else { - die "$0: parsing file '$file' failed (N='@cmdnames' D='$cmddesc')\n"; - } } -foreach (sort keys %entries) { - my $prefix = "\t"x5 . ' '; - my $id = $_; - $id =~ s/ /_/g; - my $synopsis = "\"$entries{$_}{cmdsynopsis}\""; - $synopsis =~ s/\\n/\\n"\n$prefix"/g; - my @args = ("buf", - $synopsis, - map("_(\"$_\")", @{$entries{$_}{params}})); - print HFILE "extern void sql_help_$id(PQExpBuffer buf);\n"; - print CFILE "void +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} })); + print HFILE "extern void sql_help_$id(PQExpBuffer buf);\n"; + print CFILE "void sql_help_$id(PQExpBuffer buf) { -\tappendPQExpBuffer(".join(",\n$prefix", @args)."); +\tappendPQExpBuffer(" . join(",\n$prefix", @args) . "); } "; @@ -164,10 +184,11 @@ print HFILE " static const struct _helpStruct QL_HELP[] = { "; -foreach (sort keys %entries) { - my $id = $_; - $id =~ s/ /_/g; - print HFILE " { \"$_\", +foreach (sort keys %entries) +{ + my $id = $_; + $id =~ s/ /_/g; + print HFILE " { \"$_\", N_(\"$entries{$_}{cmddesc}\"), sql_help_$id, $entries{$_}{nl_count} }, @@ -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) */ diff --git a/src/interfaces/ecpg/preproc/check_rules.pl b/src/interfaces/ecpg/preproc/check_rules.pl index a975f5cdb4..06a3b4de31 100644 --- a/src/interfaces/ecpg/preproc/check_rules.pl +++ b/src/interfaces/ecpg/preproc/check_rules.pl @@ -6,7 +6,7 @@ # Copyright (c) 2009-2012, PostgreSQL Global Development Group # # Written by Michael Meskes -# Andy Colson +# Andy Colson # # Placed under the same license as PostgreSQL. # @@ -25,7 +25,7 @@ if ($ARGV[0] eq '-v') { $verbose = shift; } -my $path = shift || '.'; +my $path = shift || '.'; my $parser = shift || '../../../backend/parser/gram.y'; my $filename = $path . "/ecpg.addons"; @@ -37,32 +37,31 @@ if ($verbose) my %replace_line = ( 'ExecuteStmtEXECUTEnameexecute_param_clause' => - 'EXECUTE prepared_name execute_param_clause execute_rest', + '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; my $brace_indent = 0; my (@arr, %found); -my $comment = 0; +my $comment = 0; my $non_term_id = ''; -my $cc = 0; +my $cc = 0; open GRAM, $parser or die $!; -while () +while () { - if (/^%%/) + if (/^%%/) { $yaccmode++; } - if ( $yaccmode != 1 ) + if ($yaccmode != 1) { next; } @@ -80,50 +79,51 @@ while () s|\*\/| */ |g; # Now split the line into individual fields - my $n = ( @arr = split( ' ' ) ); + my $n = (@arr = split(' ')); # Go through each field in turn - for ( my $fieldIndexer = 0 ; $fieldIndexer < $n ; $fieldIndexer++ ) + for (my $fieldIndexer = 0; $fieldIndexer < $n; $fieldIndexer++) { - if ( $arr[$fieldIndexer] eq '*/' && $comment ) + if ($arr[$fieldIndexer] eq '*/' && $comment) { $comment = 0; 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; } - elsif ( $arr[$fieldIndexer] eq '}' ) + elsif ($arr[$fieldIndexer] eq '}') { $brace_indent--; next; } - elsif ( $arr[$fieldIndexer] eq '{' ) + elsif ($arr[$fieldIndexer] eq '{') { $brace_indent++; next; } - if ( $brace_indent > 0 ) + if ($brace_indent > 0) { next; } - if ( $arr[$fieldIndexer] eq ';' || $arr[$fieldIndexer] eq '|' ) + if ($arr[$fieldIndexer] eq ';' || $arr[$fieldIndexer] eq '|') { $block = $non_term_id . $block; - if ( $replace_line{$block} ) + if ($replace_line{$block}) { $block = $non_term_id . $replace_line{$block}; $block =~ tr/ |//d; @@ -132,13 +132,13 @@ while () $cc++; $block = ''; } - elsif ( ( $arr[$fieldIndexer] =~ '[A-Za-z0-9]+:' ) - || $arr[ $fieldIndexer + 1 ] eq ':' ) + elsif (($arr[$fieldIndexer] =~ '[A-Za-z0-9]+:') + || $arr[ $fieldIndexer + 1 ] eq ':') { $non_term_id = $arr[$fieldIndexer]; $non_term_id =~ tr/://d; } - else + else { $block = $block . $arr[$fieldIndexer]; } @@ -155,16 +155,16 @@ my $ret = 0; $cc = 0; open ECPG, $filename or die $!; -while () +while () { - if ( !/^ECPG:/ ) + if (!/^ECPG:/) { next; } - my @Fld = split( ' ', $_, 3 ); + my @Fld = split(' ', $_, 3); $cc++; - if ( not exists $found{ $Fld[1] } ) + if (not exists $found{ $Fld[1] }) { print $Fld[1], " is not used for building parser!\n"; $ret = 1; diff --git a/src/interfaces/ecpg/preproc/parse.pl b/src/interfaces/ecpg/preproc/parse.pl index 0e7bc5eecc..c772b2ac95 100644 --- a/src/interfaces/ecpg/preproc/parse.pl +++ b/src/interfaces/ecpg/preproc/parse.pl @@ -7,7 +7,7 @@ # # Written by Mike Aubury # Michael Meskes -# Andy Colson +# Andy Colson # # Placed under the same license as PostgreSQL. # @@ -26,9 +26,9 @@ my $header_included = 0; my $feature_not_supported = 0; my $tokenmode = 0; -my(%buff, $infield, $comment, %tokens, %addons ); -my($stmt_mode, @fields); -my($line, $non_term_id); +my (%buff, $infield, $comment, %tokens, %addons); +my ($stmt_mode, @fields); +my ($line, $non_term_id); # some token have to be replaced by other symbols @@ -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. @@ -90,18 +87,21 @@ my %replace_line = ( 'fetch_argsFORWARDopt_from_incursor_name' => 'ignore', 'fetch_argsBACKWARDopt_from_incursor_name' => 'ignore', "opt_array_boundsopt_array_bounds'['Iconst']'" => 'ignore', - 'VariableShowStmtSHOWvar_name' => 'SHOW var_name ecpg_into', + 'VariableShowStmtSHOWvar_name' => 'SHOW var_name ecpg_into', 'VariableShowStmtSHOWTIMEZONE' => 'SHOW TIME ZONE ecpg_into', - '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', -); + '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',); preload_addons(); @@ -112,44 +112,45 @@ dump_buffer('tokens'); dump_buffer('types'); dump_buffer('ecpgtype'); dump_buffer('orig_tokens'); -print '%%', "\n"; +print '%%', "\n"; print 'prog: statements;', "\n"; dump_buffer('rules'); -include_file( 'trailer', 'ecpg.trailer' ); +include_file('trailer', 'ecpg.trailer'); dump_buffer('trailer'); sub main { - line: while (<>) + line: while (<>) { - if (/ERRCODE_FEATURE_NOT_SUPPORTED/) + if (/ERRCODE_FEATURE_NOT_SUPPORTED/) { $feature_not_supported = 1; next line; } - chomp; - - # comment out the line below to make the result file match (blank line wise) - # the prior version. - #next if ($_ eq ''); + chomp; - # Dump the action for a rule - - # stmt_mode indicates if we are processing the 'stmt:' - # rule (mode==0 means normal, mode==1 means stmt:) - # flds are the fields to use. These may start with a '$' - in - # which case they are the result of a previous non-terminal - # - # if they dont start with a '$' then they are token name - # - # len is the number of fields in flds... - # leadin is the padding to apply at the beginning (just use for formatting) + # comment out the line below to make the result file match (blank line wise) + # the prior version. + #next if ($_ eq ''); - if (/^%%/) { + # Dump the action for a rule - + # stmt_mode indicates if we are processing the 'stmt:' + # rule (mode==0 means normal, mode==1 means stmt:) + # flds are the fields to use. These may start with a '$' - in + # which case they are the result of a previous non-terminal + # + # if they dont start with a '$' then they are token name + # + # len is the number of fields in flds... + # leadin is the padding to apply at the beginning (just use for formatting) + + if (/^%%/) + { $tokenmode = 2; $copymode = 1; $yaccmode++; - $infield = 0; + $infield = 0; } my $prec = 0; @@ -165,130 +166,136 @@ sub main # Now split the line into individual fields my @arr = split(' '); - if ( $arr[0] eq '%token' && $tokenmode == 0 ) + if ($arr[0] eq '%token' && $tokenmode == 0) { $tokenmode = 1; - include_file( 'tokens', 'ecpg.tokens' ); + include_file('tokens', 'ecpg.tokens'); } - elsif ( $arr[0] eq '%type' && $header_included == 0 ) + elsif ($arr[0] eq '%type' && $header_included == 0) { - include_file( 'header', 'ecpg.header' ); - include_file( 'ecpgtype', 'ecpg.type' ); + include_file('header', 'ecpg.header'); + include_file('ecpgtype', 'ecpg.type'); $header_included = 1; } - if ( $tokenmode == 1 ) + if ($tokenmode == 1) { - my $str = ''; + my $str = ''; my $prior = ''; for my $a (@arr) { - if ( $a eq '/*' ) + if ($a eq '/*') { $comment++; next; } - if ( $a eq '*/' ) + if ($a eq '*/') { $comment--; next; } - if ($comment) + if ($comment) { next; } - if ( substr( $a, 0, 1 ) eq '<' ) { + if (substr($a, 0, 1) eq '<') + { next; # its a type } - $tokens{ $a } = 1; + $tokens{$a} = 1; $str = $str . ' ' . $a; - if ( $a eq 'IDENT' && $prior eq '%nonassoc' ) + if ($a eq 'IDENT' && $prior eq '%nonassoc') { + # add two more tokens to the list $str = $str . "\n%nonassoc CSTRING\n%nonassoc UIDENT"; } $prior = $a; } - add_to_buffer( 'orig_tokens', $str ); + add_to_buffer('orig_tokens', $str); next line; } - # Dont worry about anything if we're not in the right section of gram.y - if ( $yaccmode != 1 ) + # Dont worry about anything if we're not in the right section of gram.y + if ($yaccmode != 1) { next line; } - + # Go through each field in turn - for (my $fieldIndexer = 0 ; $fieldIndexer < scalar(@arr) ; $fieldIndexer++ ) + for ( + my $fieldIndexer = 0; + $fieldIndexer < scalar(@arr); + $fieldIndexer++) { - if ( $arr[$fieldIndexer] eq '*/' && $comment ) + if ($arr[$fieldIndexer] eq '*/' && $comment) { $comment = 0; 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; } - elsif ( $arr[$fieldIndexer] eq '}' ) + elsif ($arr[$fieldIndexer] eq '}') { $brace_indent--; next; } - elsif ( $arr[$fieldIndexer] eq '{' ) + elsif ($arr[$fieldIndexer] eq '{') { $brace_indent++; next; } - if ( $brace_indent > 0 ) + if ($brace_indent > 0) { next; } - if ( $arr[$fieldIndexer] eq ';' ) + if ($arr[$fieldIndexer] eq ';') { - if ($copymode) + if ($copymode) { - if ( $infield ) + if ($infield) { - dump_line( $stmt_mode, \@fields ); + dump_line($stmt_mode, \@fields); } - add_to_buffer( 'rules', ";\n\n" ); + add_to_buffer('rules', ";\n\n"); } - else + else { $copymode = 1; } - @fields = (); - $infield = 0; - $line = ''; + @fields = (); + $infield = 0; + $line = ''; next; } - if ( $arr[$fieldIndexer] eq '|' ) + if ($arr[$fieldIndexer] eq '|') { - if ($copymode) + if ($copymode) { - if ( $infield ) + if ($infield) { - $infield = $infield + dump_line( $stmt_mode, \@fields ); + $infield = $infield + dump_line($stmt_mode, \@fields); } - if ( $infield > 1 ) + if ($infield > 1) { $line = '| '; } @@ -297,24 +304,24 @@ sub main next; } - if ( exists $replace_token{ $arr[$fieldIndexer] } ) + if (exists $replace_token{ $arr[$fieldIndexer] }) { $arr[$fieldIndexer] = $replace_token{ $arr[$fieldIndexer] }; } # Are we looking at a declaration of a non-terminal ? - if ( ( $arr[$fieldIndexer] =~ /[A-Za-z0-9]+:/ ) - || $arr[ $fieldIndexer + 1 ] eq ':' ) + if (($arr[$fieldIndexer] =~ /[A-Za-z0-9]+:/) + || $arr[ $fieldIndexer + 1 ] eq ':') { $non_term_id = $arr[$fieldIndexer]; $non_term_id =~ tr/://d; - if ( not defined $replace_types{$non_term_id} ) + if (not defined $replace_types{$non_term_id}) { $replace_types{$non_term_id} = ''; $copymode = 1; } - elsif ( $replace_types{$non_term_id} eq 'ignore' ) + elsif ($replace_types{$non_term_id} eq 'ignore') { $copymode = 0; $line = ''; @@ -324,38 +331,43 @@ sub main # Do we have the : attached already ? # If yes, we'll have already printed the ':' - if ( !( $arr[$fieldIndexer] =~ '[A-Za-z0-9]+:' ) ) + if (!($arr[$fieldIndexer] =~ '[A-Za-z0-9]+:')) { + # Consume the ':' which is next... $line = $line . ':'; $fieldIndexer++; } # Special mode? - if ( $non_term_id eq 'stmt' ) + if ($non_term_id eq 'stmt') { $stmt_mode = 1; } - else + else { $stmt_mode = 0; } - my $tstr = '%type ' . $replace_types{$non_term_id} . ' ' . $non_term_id; - add_to_buffer( 'types', $tstr ); + my $tstr = + '%type ' + . $replace_types{$non_term_id} . ' ' + . $non_term_id; + add_to_buffer('types', $tstr); - if ($copymode) + if ($copymode) { - add_to_buffer( 'rules', $line ); + add_to_buffer('rules', $line); } - $line = ''; - @fields = (); - $infield = 1; + $line = ''; + @fields = (); + $infield = 1; next; } - elsif ($copymode) { + elsif ($copymode) + { $line = $line . ' ' . $arr[$fieldIndexer]; } - if ( $arr[$fieldIndexer] eq '%prec' ) + if ($arr[$fieldIndexer] eq '%prec') { $prec = 1; next; @@ -364,38 +376,37 @@ sub main if ( $copymode && !$prec && !$comment - && length( $arr[$fieldIndexer] ) - && $infield ) + && 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] } ) + if (exists $replace_string{ $arr[$fieldIndexer] }) { $S = $replace_string{ $arr[$fieldIndexer] }; } - else + else { $S = $arr[$fieldIndexer]; } $S =~ s/_P//g; $S =~ tr/'//d; - if ( $stmt_mode == 1 ) + if ($stmt_mode == 1) { push(@fields, $S); } - else + else { push(@fields, lc($S)); } } - else + else { - push(@fields, '$' . (scalar(@fields)+1)); + push(@fields, '$' . (scalar(@fields) + 1)); } } } @@ -405,43 +416,43 @@ sub main # append a file onto a buffer. # Arguments: buffer_name, filename (without path) -sub include_file +sub include_file { my ($buffer, $filename) = @_; my $full = "$path/$filename"; open(my $fh, '<', $full) or die; - while ( <$fh> ) + while (<$fh>) { chomp; - add_to_buffer( $buffer, $_ ); + add_to_buffer($buffer, $_); } close($fh); } sub include_addon { - my($buffer, $block, $fields, $stmt_mode) = @_; + my ($buffer, $block, $fields, $stmt_mode) = @_; my $rec = $addons{$block}; return 0 unless $rec; - - if ( $rec->{type} eq 'rule' ) + + if ($rec->{type} eq 'rule') { - dump_fields( $stmt_mode, $fields, ' { ' ); + dump_fields($stmt_mode, $fields, ' { '); } - elsif ( $rec->{type} eq 'addon' ) + elsif ($rec->{type} eq 'addon') { - add_to_buffer( 'rules', ' { ' ); + add_to_buffer('rules', ' { '); } #add_to_buffer( $stream, $_ ); - #We have an array to add to the buffer, we'll add it ourself instead of + #We have an array to add to the buffer, we'll add it ourself instead of #calling add_to_buffer, which does not know about arrays - - push( @{ $buff{$buffer} }, @{ $rec->{lines} } ); - if ( $rec->{type} eq 'addon' ) + push(@{ $buff{$buffer} }, @{ $rec->{lines} }); + + if ($rec->{type} eq 'addon') { - dump_fields( $stmt_mode, $fields, '' ); + dump_fields($stmt_mode, $fields, ''); } @@ -454,56 +465,60 @@ sub include_addon # include_addon does this same thing, but does not call this # sub... so if you change this, you need to fix include_addon too # Pass: buffer_name, string_to_append -sub add_to_buffer +sub add_to_buffer { - push( @{ $buff{$_[0]} }, "$_[1]\n" ); + push(@{ $buff{ $_[0] } }, "$_[1]\n"); } -sub dump_buffer +sub dump_buffer { - my($buffer) = @_; - print '/* ', $buffer, ' */',"\n"; + my ($buffer) = @_; + print '/* ', $buffer, ' */', "\n"; my $ref = $buff{$buffer}; print @$ref; } -sub dump_fields +sub dump_fields { - my ( $mode, $flds, $ln ) = @_; + my ($mode, $flds, $ln) = @_; my $len = scalar(@$flds); - if ( $mode == 0 ) + if ($mode == 0) { + #Normal - add_to_buffer( 'rules', $ln ); - if ( $feature_not_supported == 1 ) + 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 - if ( $flds->[0] ne 'create' || $flds->[2] ne 'table' ) + if ($flds->[0] ne 'create' || $flds->[2] ne 'table') { - add_to_buffer( 'rules', - 'mmerror(PARSE_ERROR, ET_WARNING, "unsupported feature will be passed to server");' + add_to_buffer('rules', +'mmerror(PARSE_ERROR, ET_WARNING, "unsupported feature will be passed to server");' ); } $feature_not_supported = 0; } - if ( $len == 0 ) + if ($len == 0) { + # We have no fields ? - add_to_buffer( 'rules', ' $$=EMPTY; }' ); - } - else + add_to_buffer('rules', ' $$=EMPTY; }'); + } + else { - # Go through each field and try to 'aggregate' the tokens + + # Go through each field and try to 'aggregate' the tokens # into a single 'mm_strdup' where possible my @flds_new; my $str; - for ( my $z = 0 ; $z < $len ; $z++ ) + for (my $z = 0; $z < $len; $z++) { - if ( substr( $flds->[$z], 0, 1 ) eq '$' ) + if (substr($flds->[$z], 0, 1) eq '$') { push(@flds_new, $flds->[$z]); next; @@ -511,12 +526,14 @@ sub dump_fields $str = $flds->[$z]; - while (1) + while (1) { - if ( $z >= $len - 1 || substr( $flds->[ $z + 1 ], 0, 1 ) eq '$' ) + if ($z >= $len - 1 + || substr($flds->[ $z + 1 ], 0, 1) eq '$') { + # We're at the end... - push(@flds_new, "mm_strdup(\"$str\")"); + push(@flds_new, "mm_strdup(\"$str\")"); last; } $z++; @@ -526,67 +543,73 @@ sub dump_fields # So - how many fields did we end up with ? $len = scalar(@flds_new); - if ( $len == 1 ) + if ($len == 1) { + # Straight assignement $str = ' $$ = ' . $flds_new[0] . ';'; - add_to_buffer( 'rules', $str ); + add_to_buffer('rules', $str); } - else + else { + # Need to concatenate the results to form # our final string - $str = ' $$ = cat_str(' . $len . ',' . join(',', @flds_new) . ');'; - add_to_buffer( 'rules', $str ); + $str = + ' $$ = cat_str(' . $len . ',' . join(',', @flds_new) . ');'; + add_to_buffer('rules', $str); } - add_to_buffer( 'rules', '}' ); + add_to_buffer('rules', '}'); } } 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 { - add_to_buffer( 'rules', ' { $$ = NULL; }' ); + add_to_buffer('rules', ' { $$ = NULL; }'); } } } -sub dump_line +sub dump_line { - my($stmt_mode, $fields) = @_; + my ($stmt_mode, $fields) = @_; my $block = $non_term_id . $line; $block =~ tr/ |//d; my $rep = $replace_line{$block}; if ($rep) { - if ($rep eq 'ignore' ) + if ($rep eq 'ignore') { return 0; } - if ( index( $line, '|' ) != -1 ) + if (index($line, '|') != -1) { $line = '| ' . $rep; } - else + else { $line = $rep; } $block = $non_term_id . $line; $block =~ tr/ |//d; } - add_to_buffer( 'rules', $line ); - my $i = include_addon( 'rules', $block, $fields, $stmt_mode); - if ( $i == 0 ) + add_to_buffer('rules', $line); + my $i = include_addon('rules', $block, $fields, $stmt_mode); + if ($i == 0) { - dump_fields( $stmt_mode, $fields, ' { ' ); + dump_fields($stmt_mode, $fields, ' { '); } return 1; } @@ -599,16 +622,19 @@ 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. + + # 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> ) + while (<$fh>) { if (/^ECPG:\s(\S+)\s?(\w+)?/) { @@ -619,16 +645,16 @@ sub preload_addons { push(@{ $x->{lines} }, @code); } - @code = (); + @code = (); @needsRules = (); } - $record = {}; - $record->{type} = $2; + $record = {}; + $record->{type} = $2; $record->{lines} = []; if (exists $addons{$1}) { die "Ga! there are dups!\n"; } $addons{$1} = $record; push(@needsRules, $record); - } + } else { next if $skip; diff --git a/src/pl/plperl/plc_perlboot.pl b/src/pl/plperl/plc_perlboot.pl index e3e507722a..d506d01163 100644 --- a/src/pl/plperl/plc_perlboot.pl +++ b/src/pl/plperl/plc_perlboot.pl @@ -7,99 +7,113 @@ 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)); + 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 { - (my $msg = shift) =~ s/\(eval \d+\) //g; - chomp $msg; - &::elog(&::WARNING, $msg); -} -$SIG{__WARN__} = \&plperl_warn; + package PostgreSQL::InServer; + use strict; + use warnings; -sub plperl_die { - (my $msg = shift) =~ s/\(eval \d+\) //g; - die $msg; -} -$SIG{__DIE__} = \&plperl_die; + sub plperl_warn + { + (my $msg = shift) =~ s/\(eval \d+\) //g; + chomp $msg; + &::elog(&::WARNING, $msg); + } + $SIG{__WARN__} = \&plperl_warn; -sub mkfuncsrc { - my ($name, $imports, $prolog, $src) = @_; + sub plperl_die + { + (my $msg = shift) =~ s/\(eval \d+\) //g; + die $msg; + } + $SIG{__DIE__} = \&plperl_die; - my $BEGIN = join "\n", map { - my $names = $imports->{$_} || []; - "$_->import(qw(@$names));" - } sort keys %$imports; - $BEGIN &&= "BEGIN { $BEGIN }"; + sub mkfuncsrc + { + my ($name, $imports, $prolog, $src) = @_; - return qq[ package main; sub { $BEGIN $prolog $src } ]; -} + my $BEGIN = join "\n", map { + my $names = $imports->{$_} || []; + "$_->import(qw(@$names));" + } sort keys %$imports; + $BEGIN &&= "BEGIN { $BEGIN }"; -sub mkfunc { - no strict; # default to no strict for the eval - no warnings; # default to no warnings for the eval - my $ret = eval(mkfuncsrc(@_)); - $@ =~ s/\(eval \d+\) //g if $@; - return $ret; -} + return qq[ package main; sub { $BEGIN $prolog $src } ]; + } -1; + sub mkfunc + { + no strict; # default to no strict for the eval + no warnings; # default to no warnings for the eval + my $ret = eval(mkfuncsrc(@_)); + $@ =~ s/\(eval \d+\) //g if $@; + return $ret; + } + + 1; } { -package PostgreSQL::InServer::ARRAY; -use strict; -use warnings; -use overload - '""'=>\&to_str, - '@{}'=>\&to_arr; + package PostgreSQL::InServer::ARRAY; + use strict; + use warnings; -sub to_str { - my $self = shift; - return ::encode_typed_literal($self->{'array'}, $self->{'typeoid'}); -} - -sub to_arr { - return shift->{'array'}; -} - -1; + use overload + '""' => \&to_str, + '@{}' => \&to_arr; + + sub to_str + { + my $self = shift; + return ::encode_typed_literal($self->{'array'}, $self->{'typeoid'}); + } + + sub to_arr + { + return shift->{'array'}; + } + + 1; } diff --git a/src/pl/plperl/plperl_opmask.pl b/src/pl/plperl/plperl_opmask.pl index 3e9ecaa3c1..61e5cac148 100644 --- a/src/pl/plperl/plperl_opmask.pl +++ b/src/pl/plperl/plperl_opmask.pl @@ -5,54 +5,59 @@ use warnings; use Opcode qw(opset opset_to_ops opdesc); -my $plperl_opmask_h = shift - or die "Usage: $0 \n"; +my $plperl_opmask_h = shift + or die "Usage: $0 \n"; -my $plperl_opmask_tmp = $plperl_opmask_h."tmp"; +my $plperl_opmask_tmp = $plperl_opmask_h . "tmp"; END { unlink $plperl_opmask_tmp } open my $fh, ">", "$plperl_opmask_tmp" - or die "Could not write to $plperl_opmask_tmp: $!"; + or die "Could not write to $plperl_opmask_tmp: $!"; printf $fh "#define PLPERL_SET_OPMASK(opmask) \\\n"; printf $fh " 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], -); + + # 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],); 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); + uc($opname), opdesc($opname); } printf $fh " /* end */ \n"; close $fh - or die "Error closing $plperl_opmask_tmp: $!"; + or die "Error closing $plperl_opmask_tmp: $!"; rename $plperl_opmask_tmp, $plperl_opmask_h - or die "Error renaming $plperl_opmask_tmp to $plperl_opmask_h: $!"; + or die "Error renaming $plperl_opmask_tmp to $plperl_opmask_h: $!"; exit 0; diff --git a/src/pl/plperl/text2macro.pl b/src/pl/plperl/text2macro.pl index 88241e2cb2..c88e5ec4be 100644 --- a/src/pl/plperl/text2macro.pl +++ b/src/pl/plperl/text2macro.pl @@ -32,11 +32,10 @@ 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; + unless @ARGV; print qq{ /* @@ -45,17 +44,19 @@ print qq{ */ }; -for my $src_file (@ARGV) { +for my $src_file (@ARGV) +{ (my $macro = $src_file) =~ s/ .*? (\w+) (?:\.\w+) $/$1/x; - open my $src_fh, $src_file # not 3-arg form - or die "Can't open $src_file: $!"; + open my $src_fh, $src_file # not 3-arg form + or die "Can't open $src_file: $!"; printf qq{#define %s%s \\\n}, - $opt_prefix || '', - ($opt_name) ? $opt_name : uc $macro; - while (<$src_fh>) { + $opt_prefix || '', + ($opt_name) ? $opt_name : uc $macro; + while (<$src_fh>) + { chomp; next if $opt_strip and m/$opt_strip/o; @@ -74,8 +75,9 @@ print "/* end */\n"; exit 0; -sub selftest { - my $tmp = "text2macro_tmp"; +sub selftest +{ + my $tmp = "text2macro_tmp"; my $string = q{a '' '\\'' "" "\\"" "\\\\" "\\\\n" b}; open my $fh, ">$tmp.pl" or die; diff --git a/src/pl/plpgsql/src/generate-plerrcodes.pl b/src/pl/plpgsql/src/generate-plerrcodes.pl index 066f83d178..89c6a13705 100644 --- a/src/pl/plpgsql/src/generate-plerrcodes.pl +++ b/src/pl/plpgsql/src/generate-plerrcodes.pl @@ -6,35 +6,35 @@ 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>) { - chomp; +while (<$errcodes>) +{ + chomp; - # Skip comments - next if /^#/; - next if /^\s*$/; + # Skip comments + next if /^#/; + next if /^\s*$/; - # Skip section headers - next if /^Section:/; + # Skip section headers + next if /^Section:/; - die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/; + die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/; - (my $sqlstate, - my $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'; + # Skip non-errors + next unless $type eq 'E'; - # Skip lines without PL/pgSQL condition names - next unless defined($condition_name); + # Skip lines without PL/pgSQL condition names + next unless defined($condition_name); - print "{\n\t\"$condition_name\", $errcode_macro\n},\n\n"; + print "{\n\t\"$condition_name\", $errcode_macro\n},\n\n"; } close $errcodes; diff --git a/src/pl/plpython/generate-spiexceptions.pl b/src/pl/plpython/generate-spiexceptions.pl index c29a03e05c..31bf5bfd79 100644 --- a/src/pl/plpython/generate-spiexceptions.pl +++ b/src/pl/plpython/generate-spiexceptions.pl @@ -6,39 +6,39 @@ 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>) { - chomp; +while (<$errcodes>) +{ + chomp; - # Skip comments - next if /^#/; - next if /^\s*$/; + # Skip comments + next if /^#/; + next if /^\s*$/; - # Skip section headers - next if /^Section:/; + # Skip section headers + next if /^Section:/; - die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/; + die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/; - (my $sqlstate, - my $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'; + # Skip non-errors + next unless $type eq 'E'; - # Skip lines without PL/pgSQL condition names - next unless defined($condition_name); + # Skip lines without PL/pgSQL condition names + next unless defined($condition_name); - # Change some_error_condition to SomeErrorCondition - $condition_name =~ s/([a-z])([^_]*)(?:_|$)/\u$1$2/g; + # 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; diff --git a/src/test/locale/sort-test.pl b/src/test/locale/sort-test.pl index aedfa22c88..ce7b93c571 100755 --- a/src/test/locale/sort-test.pl +++ b/src/test/locale/sort-test.pl @@ -2,10 +2,10 @@ use locale; open(INFILE, "<$ARGV[0]"); -chop(my(@words) = ); +chop(my (@words) = ); close(INFILE); -$"="\n"; -my(@result) = sort @words; +$" = "\n"; +my (@result) = sort @words; print "@result\n"; diff --git a/src/test/performance/runtests.pl b/src/test/performance/runtests.pl index edf45ded2f..9c61b9a120 100755 --- a/src/test/performance/runtests.pl +++ b/src/test/performance/runtests.pl @@ -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 = in single xaction -'slcsimple T', '8192 random INDEX scans on SIMPLE (1 xact)', -# SELECT * FROM simple ORDER BY justint -'orbsimple', 'ORDER BY SIMPLE', -); + + # 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 = in single xaction + 'slcsimple T', '8192 random INDEX scans on SIMPLE (1 xact)', + + # SELECT * FROM simple ORDER BY justint + 'orbsimple', 'ORDER BY SIMPLE',); # # It seems that nothing below need to be changed @@ -66,72 +73,76 @@ $DBNAME = 'perftest'; $TestDBMS = $ARGV[0]; die "Unsupported DBMS $TestDBMS\n" if !exists $DBMS{$TestDBMS}; -$FrontEnd = $DBMS{$TestDBMS}[0]; +$FrontEnd = $DBMS{$TestDBMS}[0]; $DestroyDB = $DBMS{$TestDBMS}[1]; -$CreateDB = $DBMS{$TestDBMS}[2]; +$CreateDB = $DBMS{$TestDBMS}[2]; print "(Re)create DataBase $DBNAME\n"; -`$DestroyDB`; # Destroy DB -`$CreateDB`; # Create DB +`$DestroyDB`; # Destroy DB +`$CreateDB`; # Create DB $ResFile = "Results.$TestDBMS"; $TmpFile = "Tmp.$TestDBMS"; -open (SAVEOUT, ">&STDOUT"); -open (STDOUT, ">/dev/null") or die; -open (SAVEERR, ">&STDERR"); -open (STDERR, ">$TmpFile") or die; -select (STDERR); $| = 1; +open(SAVEOUT, ">&STDOUT"); +open(STDOUT, ">/dev/null") or die; +open(SAVEERR, ">&STDERR"); +open(STDERR, ">$TmpFile") or die; +select(STDERR); +$| = 1; for ($i = 0; $i <= $#perftests; $i++) { $test = $perftests[$i]; - ($test, $XACTBLOCK) = split (/ /, $test); + ($test, $XACTBLOCK) = split(/ /, $test); $runtest = $test; - if ( $test =~ /\.ntm/ ) + if ($test =~ /\.ntm/) { + # # No timing for this queries # - close (STDERR); # close $TmpFile - open (STDERR, ">/dev/null") or die; + close(STDERR); # close $TmpFile + open(STDERR, ">/dev/null") or die; $runtest =~ s/\.ntm//; } else { - close (STDOUT); + close(STDOUT); open(STDOUT, ">&SAVEOUT"); print STDOUT "\nRunning: $perftests[$i+1] ..."; - close (STDOUT); - open (STDOUT, ">/dev/null") or die; - select (STDERR); $| = 1; + close(STDOUT); + open(STDOUT, ">/dev/null") or die; + select(STDERR); + $| = 1; printf "$perftests[$i+1]: "; } do "sqls/$runtest"; # Restore STDERR to $TmpFile - if ( $test =~ /\.ntm/ ) + if ($test =~ /\.ntm/) { - close (STDERR); - open (STDERR, ">>$TmpFile") or die; + close(STDERR); + open(STDERR, ">>$TmpFile") or die; } - select (STDERR); $| = 1; + select(STDERR); + $| = 1; $i++; } -close (STDERR); +close(STDERR); open(STDERR, ">&SAVEERR"); -open (TMPF, "<$TmpFile") or die; -open (RESF, ">$ResFile") or die; +open(TMPF, "<$TmpFile") or die; +open(RESF, ">$ResFile") or die; while () { $str = $_; - ($test, $rtime) = split (/:/, $str); - ($tmp, $rtime, $rest) = split (/[ ]+/, $rtime); + ($test, $rtime) = split(/:/, $str); + ($tmp, $rtime, $rest) = split(/[ ]+/, $rtime); print RESF "$test: $rtime\n"; } diff --git a/src/tools/check_bison_recursion.pl b/src/tools/check_bison_recursion.pl index f350b26992..142a7839bd 100755 --- a/src/tools/check_bison_recursion.pl +++ b/src/tools/check_bison_recursion.pl @@ -32,43 +32,59 @@ my $cur_nonterminal; # We parse the input and emit warnings on the fly. my $in_grammar = 0; -while (<>) { - my $rule_number; - my $rhs; +while (<>) +{ + my $rule_number; + my $rhs; - # We only care about the "Grammar" part of the input. - if (m/^Grammar$/) { - $in_grammar = 1; - } elsif (m/^Terminal/) { - $in_grammar = 0; - } elsif ($in_grammar) { - if (m/^\s*(\d+)\s+(\S+):\s+(.*)$/) { - # first rule for nonterminal - $rule_number = $1; - $cur_nonterminal = $2; - $rhs = $3; - } elsif (m/^\s*(\d+)\s+\|\s+(.*)$/) { - # additional rule for nonterminal - $rule_number = $1; - $rhs = $2; + # We only care about the "Grammar" part of the input. + if (m/^Grammar$/) + { + $in_grammar = 1; } - } + elsif (m/^Terminal/) + { + $in_grammar = 0; + } + elsif ($in_grammar) + { + if (m/^\s*(\d+)\s+(\S+):\s+(.*)$/) + { - # Process rule if we found one - if (defined $rule_number) { - # deconstruct the RHS - $rhs =~ s|^/\* empty \*/$||; - my @rhs = split '\s', $rhs; - print "Rule $rule_number: $cur_nonterminal := @rhs\n" if $debug; - # 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"; + # first rule for nonterminal + $rule_number = $1; + $cur_nonterminal = $2; + $rhs = $3; + } + elsif (m/^\s*(\d+)\s+\|\s+(.*)$/) + { + + # additional rule for nonterminal + $rule_number = $1; + $rhs = $2; + } + } + + # Process rule if we found one + if (defined $rule_number) + { + + # deconstruct the RHS + $rhs =~ s|^/\* empty \*/$||; + my @rhs = split '\s', $rhs; + print "Rule $rule_number: $cur_nonterminal := @rhs\n" if $debug; + + # 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"; + } } - } } exit 0; diff --git a/src/tools/check_keywords.pl b/src/tools/check_keywords.pl index 33816c5133..77fbd9a44e 100755 --- a/src/tools/check_keywords.pl +++ b/src/tools/check_keywords.pl @@ -10,26 +10,30 @@ use strict; my $errors = 0; my $path; -sub error(@) { - print STDERR @_; - $errors = 1; +sub error(@) +{ + print STDERR @_; + $errors = 1; } -if (@ARGV) { +if (@ARGV) +{ $path = $ARGV[0]; shift @ARGV; -} else { +} +else +{ $path = "."; } -$, = ' '; # set output field separator -$\ = "\n"; # set output record separator +$, = ' '; # set output field separator +$\ = "\n"; # set output record separator my %keyword_categories; -$keyword_categories{'unreserved_keyword'} = 'UNRESERVED_KEYWORD'; -$keyword_categories{'col_name_keyword'} = 'COL_NAME_KEYWORD'; +$keyword_categories{'unreserved_keyword'} = 'UNRESERVED_KEYWORD'; +$keyword_categories{'col_name_keyword'} = 'COL_NAME_KEYWORD'; $keyword_categories{'type_func_name_keyword'} = 'TYPE_FUNC_NAME_KEYWORD'; -$keyword_categories{'reserved_keyword'} = 'RESERVED_KEYWORD'; +$keyword_categories{'reserved_keyword'} = 'RESERVED_KEYWORD'; my $gram_filename = "$path/src/backend/parser/gram.y"; open(GRAM, $gram_filename) || die("Could not open : $gram_filename"); @@ -39,80 +43,101 @@ my $comment; my @arr; my %keywords; -line: while () { - chomp; # strip record separator +line: while () +{ + 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; + $S = $_; - if (!($kcat)) { - # Is this the beginning of a keyword list? - foreach $k (keys %keyword_categories) { - if ($S =~ m/^($k):/) { - $kcat = $k; + # Make sure any braces are split + $s = '{', $S =~ s/$s/ { /g; + $s = '}', $S =~ s/$s/ } /g; + + # Any comments are split + $s = '[/][*]', $S =~ s#$s# /* #g; + $s = '[*][/]', $S =~ s#$s# */ #g; + + if (!($kcat)) + { + + # Is this the beginning of a keyword list? + foreach $k (keys %keyword_categories) + { + if ($S =~ m/^($k):/) + { + $kcat = $k; + next line; + } + } next line; - } - } - next line; - } - - # Now split the line into individual fields - $n = (@arr = split(' ', $S)); - - # Ok, we're in a keyword list. Go through each field in turn - for (my $fieldIndexer = 0; $fieldIndexer < $n; $fieldIndexer++) { - if ($arr[$fieldIndexer] eq '*/' && $comment) { - $comment = 0; - next; - } - elsif ($comment) { - next; - } - elsif ($arr[$fieldIndexer] eq '/*') { - # start of a multiline comment - $comment = 1; - next; - } - elsif ($arr[$fieldIndexer] eq '//') { - next line; } - if ($arr[$fieldIndexer] eq ';') { - # end of keyword list - $kcat = ''; - next; - } + # Now split the line into individual fields + $n = (@arr = split(' ', $S)); - if ($arr[$fieldIndexer] eq '|') { - next; - } + # Ok, we're in a keyword list. Go through each field in turn + for (my $fieldIndexer = 0; $fieldIndexer < $n; $fieldIndexer++) + { + if ($arr[$fieldIndexer] eq '*/' && $comment) + { + $comment = 0; + next; + } + elsif ($comment) + { + next; + } + elsif ($arr[$fieldIndexer] eq '/*') + { - # Put this keyword into the right list - push @{$keywords{$kcat}}, $arr[$fieldIndexer]; - } + # start of a multiline comment + $comment = 1; + next; + } + elsif ($arr[$fieldIndexer] eq '//') + { + next line; + } + + if ($arr[$fieldIndexer] eq ';') + { + + # end of keyword list + $kcat = ''; + next; + } + + if ($arr[$fieldIndexer] eq '|') + { + next; + } + + # Put this keyword into the right list + push @{ $keywords{$kcat} }, $arr[$fieldIndexer]; + } } close GRAM; # Check that all keywords are in alphabetical order my ($prevkword, $kword, $bare_kword); -foreach $kcat (keys %keyword_categories) { - $prevkword = ''; +foreach $kcat (keys %keyword_categories) +{ + $prevkword = ''; - 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"; - $errors = 1; + 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"; + $errors = 1; + } + $prevkword = $bare_kword; } - $prevkword = $bare_kword; - } } # Transform the keyword lists into hashes. @@ -120,13 +145,14 @@ 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) ) { - @arr = @{$keywords{$kcat}}; +while (my ($kcat, $kcat_id) = each(%keyword_categories)) +{ + @arr = @{ $keywords{$kcat} }; - my $hash; - foreach my $item (@arr) { $hash->{$item} = 1 } + my $hash; + foreach my $item (@arr) { $hash->{$item} = 1 } - $kwhashes{$kcat_id} = $hash; + $kwhashes{$kcat_id} = $hash; } # Now read in kwlist.h @@ -137,63 +163,82 @@ open(KWLIST, $kwlist_filename) || die("Could not open : $kwlist_filename"); my $prevkwstring = ''; my $bare_kwname; my %kwhash; -kwlist_line: while () { - my($line) = $_; +kwlist_line: while () +{ + my ($line) = $_; - if ($line =~ /^PG_KEYWORD\(\"(.*)\", (.*), (.*)\)/) - { - my($kwstring) = $1; - my($kwname) = $2; - my($kwcat_id) = $3; + if ($line =~ /^PG_KEYWORD\(\"(.*)\", (.*), (.*)\)/) + { + my ($kwstring) = $1; + my ($kwname) = $2; + 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"; + # Check that the list is in alphabetical order + 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"; + } + + # Check that the keyword name is valid: all upper-case ASCII chars + if ($kwname !~ /^[A-Z_]*$/) + { + error +"'$kwname' is not a valid keyword name, must be all upper-case ASCII chars"; + } + + # Check that the keyword string matches keyword name + $bare_kwname = $kwname; + $bare_kwname =~ s/_P$//; + if ($bare_kwname ne uc($kwstring)) + { + error +"keyword name '$kwname' doesn't match keyword string '$kwstring'"; + } + + # Check that the keyword is present in the grammar + %kwhash = %{ $kwhashes{$kwcat_id} }; + + if (!(%kwhash)) + { + + #error "Unknown kwcat_id: $kwcat_id"; + } + else + { + if (!($kwhash{$kwname})) + { + error "'$kwname' not present in $kwcat_id section of gram.y"; + } + else + { + + # Remove it from the hash, so that we can complain at the end + # if there's keywords left that were not found in kwlist.h + delete $kwhashes{$kwcat_id}->{$kwname}; + } + } } - $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"; - } - - # Check that the keyword name is valid: all upper-case ASCII chars - if ($kwname !~ /^[A-Z_]*$/) { - error "'$kwname' is not a valid keyword name, must be all upper-case ASCII chars"; - } - - # Check that the keyword string matches keyword name - $bare_kwname = $kwname; - $bare_kwname =~ s/_P$//; - if ($bare_kwname ne uc($kwstring)) { - error "keyword name '$kwname' doesn't match keyword string '$kwstring'"; - } - - # Check that the keyword is present in the grammar - %kwhash = %{$kwhashes{$kwcat_id}}; - - if (!(%kwhash)) { - #error "Unknown kwcat_id: $kwcat_id"; - } else { - if (!($kwhash{$kwname})) { - error "'$kwname' not present in $kwcat_id section of gram.y"; - } else { - # Remove it from the hash, so that we can complain at the end - # if there's keywords left that were not found in kwlist.h - delete $kwhashes{$kwcat_id}->{$kwname}; - } - } - } } 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) ) { - %kwhash = %{$kwhashes{$kwcat_id}}; +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"; + } } exit $errors; diff --git a/src/tools/copyright.pl b/src/tools/copyright.pl index b8b87613f8..2ef35d2525 100755 --- a/src/tools/copyright.pl +++ b/src/tools/copyright.pl @@ -14,43 +14,52 @@ use File::Find; use Tie::File; my $pgdg = 'PostgreSQL Global Development Group'; -my $cc = 'Copyright \(c\) '; +my $cc = 'Copyright \(c\) '; + # year-1900 is what localtime(time) puts in element 5 -my $year = 1900 + ${[localtime(time)]}[5]; +my $year = 1900 + ${ [ localtime(time) ] }[5]; print "Using current year: $year\n"; -find({wanted => \&wanted, no_chdir => 1}, '.'); +find({ wanted => \&wanted, no_chdir => 1 }, '.'); -sub wanted { - # prevent corruption of git indexes by ignoring any .git/ - if ($_ eq '.git') - { - $File::Find::prune = 1; - return; - } +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)$); + # prevent corruption of git indexes by ignoring any .git/ + if ($_ eq '.git') + { + $File::Find::prune = 1; + return; + } + + 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)$); my @lines; tie @lines, "Tie::File", $File::Find::name; 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. - last if $line =~ m/$cc.*$year.*$pgdg/; - last if $line =~ s/($cc\d{4})(, $pgdg)/$1-$year$2/; - last if $line =~ s/($cc\d{4})-\d{4}(, $pgdg)/$1-$year$2/; - } - untie @lines; + 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. + last if $line =~ m/$cc.*$year.*$pgdg/; + last if $line =~ s/($cc\d{4})(, $pgdg)/$1-$year$2/; + last if $line =~ s/($cc\d{4})-\d{4}(, $pgdg)/$1-$year$2/; + } + untie @lines; } -print "Manually update doc/src/sgml/legal.sgml and src/interfaces/libpq/libpq.rc.in too.\n"; -print "Also update ./COPYRIGHT and doc/src/sgml/legal.sgml in all back branches.\n"; +print +"Manually update doc/src/sgml/legal.sgml and src/interfaces/libpq/libpq.rc.in too.\n"; +print +"Also update ./COPYRIGHT and doc/src/sgml/legal.sgml in all back branches.\n"; diff --git a/src/tools/msvc/Install.pm b/src/tools/msvc/Install.pm index 058fab3e5a..3923532a14 100644 --- a/src/tools/msvc/Install.pm +++ b/src/tools/msvc/Install.pm @@ -13,13 +13,13 @@ use File::Copy; use File::Find (); use Exporter; -our (@ISA,@EXPORT_OK); -@ISA = qw(Exporter); +our (@ISA, @EXPORT_OK); +@ISA = qw(Exporter); @EXPORT_OK = qw(Install); sub lcopy { - my $src = shift; + my $src = shift; my $target = shift; if (-f $target) @@ -27,7 +27,7 @@ sub lcopy unlink $target || confess "Could not delete $target\n"; } - copy($src,$target) + copy($src, $target) || confess "Could not copy $src to $target\n"; } @@ -41,7 +41,7 @@ sub Install require "config_default.pl"; require "config.pl" if (-f "config.pl"); - chdir("../../..") if (-f "../../../configure"); + chdir("../../..") if (-f "../../../configure"); chdir("../../../..") if (-f "../../../../configure"); my $conf = ""; if (-d "debug") @@ -56,83 +56,79 @@ 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); + && 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' - ); + 'Information schema data', $target . '/share/', + 'src/backend/catalog/', 'sql_features.txt'); GenerateConversionScript($target); - GenerateTimezoneFiles($target,$conf); + 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/' - ); - CopyContribFiles($config,$target); + $target . '/share/tsearch_data/'); + CopyContribFiles($config, $target); CopyIncludeFiles($target); my $pl_extension_files = []; - my @pldirs = ('src/pl/plpgsql/src'); - push @pldirs,"src/pl/plperl" if $config->{perl}; - push @pldirs,"src/pl/plpython" if $config->{python}; - push @pldirs,"src/pl/tcl" if $config->{tcl}; + my @pldirs = ('src/pl/plpgsql/src'); + push @pldirs, "src/pl/plperl" if $config->{perl}; + 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}); + GenerateNLSFiles($target, $config->{nls}, $majorver) if ($config->{nls}); print "Installation complete.\n"; } @@ -149,8 +145,8 @@ sub EnsureDirectories sub CopyFiles { - my $what = shift; - my $target = shift; + my $what = shift; + my $target = shift; my $basedir = shift; print "Copying $what"; @@ -166,14 +162,14 @@ sub CopyFiles sub CopySetOfFiles { - my $what = shift; - my $flist = shift; + my $what = shift; + my $flist = shift; my $target = shift; print "Copying $what" if $what; foreach (@$flist) { - next if /regress/; # Skip temporary install in regression subdir - next if /ecpg.test/; # Skip temporary install in regression subdir + next if /regress/; # Skip temporary install in regression subdir + next if /ecpg.test/; # Skip temporary install in regression subdir my $tgt = $target . basename($_); print "."; lcopy($_, $tgt) || croak "Could not copy $_: $!\n"; @@ -183,14 +179,17 @@ sub CopySetOfFiles sub CopySolutionOutput { - my $conf = shift; + 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) @@ -220,11 +220,11 @@ sub CopySolutionOutput else { - # Static lib, such as libpgport, only used internally during build, don't install +# Static lib, such as libpgport, only used internally during build, don't install next; } } - elsif ( $vcproj eq 'vcxproj' + elsif ($vcproj eq 'vcxproj' && $proj =~ qr{(\w+)}) { if ($1 eq 'Application') @@ -237,10 +237,10 @@ sub CopySolutionOutput $dir = "lib"; $ext = "dll"; } - else # 'StaticLibrary' + else # 'StaticLibrary' { - # Static lib, such as libpgport, only used internally during build, don't install +# Static lib, such as libpgport, only used internally during build, don't install next; } } @@ -248,9 +248,9 @@ sub CopySolutionOutput { croak "Could not parse $pf.$vcproj\n"; } - lcopy("$conf\\$pf\\$pf.$ext","$target\\$dir\\$pf.$ext") + lcopy("$conf\\$pf\\$pf.$ext", "$target\\$dir\\$pf.$ext") || croak "Could not copy $pf.$ext\n"; - lcopy("$conf\\$pf\\$pf.pdb","$target\\symbols\\$pf.pdb") + lcopy("$conf\\$pf\\$pf.pdb", "$target\\symbols\\$pf.pdb") || croak "Could not copy $pf.pdb\n"; print "."; } @@ -260,7 +260,7 @@ sub CopySolutionOutput sub GenerateConversionScript { my $target = shift; - my $sql = ""; + my $sql = ""; my $F; print "Generating conversion proc script..."; @@ -268,14 +268,14 @@ sub GenerateConversionScript $mf =~ s{\\\s*[\r\n]+}{}mg; $mf =~ /^CONVERSIONS\s*=\s*(.*)$/m || die "Could not find CONVERSIONS line in conversions Makefile\n"; - my @pieces = split /\s+/,$1; + my @pieces = split /\s+/, $1; while ($#pieces > 0) { my $name = shift @pieces; - my $se = shift @pieces; - my $de = shift @pieces; + my $se = shift @pieces; + my $de = shift @pieces; my $func = shift @pieces; - my $obj = shift @pieces; + my $obj = shift @pieces; $sql .= "-- $se --> $de\n"; $sql .= "CREATE OR REPLACE FUNCTION $func (INTEGER, INTEGER, CSTRING, INTERNAL, INTEGER) RETURNS VOID AS '\$libdir/$obj', '$func' LANGUAGE C STRICT;\n"; @@ -283,10 +283,11 @@ sub GenerateConversionScript "COMMENT ON FUNCTION $func(INTEGER, INTEGER, CSTRING, INTERNAL, INTEGER) IS 'internal conversion function for $se to $de';\n"; $sql .= "DROP CONVERSION pg_catalog.$name;\n"; $sql .= - "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"; +"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"; } - open($F,">$target/share/conversion_create.sql") + open($F, ">$target/share/conversion_create.sql") || die "Could not write to conversion_create.sql\n"; print $F $sql; close($F); @@ -296,12 +297,13 @@ sub GenerateConversionScript sub GenerateTimezoneFiles { my $target = shift; - my $conf = shift; - my $mf = read_file("src/timezone/Makefile"); + my $conf = shift; + my $mf = read_file("src/timezone/Makefile"); $mf =~ s{\\\s*[\r\n]+}{}mg; - $mf =~ /^TZDATA\s*:?=\s*(.*)$/m || die "Could not find TZDATA row in timezone makefile\n"; - my @tzfiles = split /\s+/,$1; - unshift @tzfiles,''; + $mf =~ /^TZDATA\s*:?=\s*(.*)$/m + || die "Could not find TZDATA row in timezone makefile\n"; + my @tzfiles = split /\s+/, $1; + unshift @tzfiles, ''; print "Generating timezone files..."; system("$conf\\zic\\zic -d \"$target/share/timezone\" " . join(" src/timezone/data/", @tzfiles)); @@ -315,21 +317,21 @@ sub GenerateTsearchFiles print "Generating tsearch script..."; my $F; my $tmpl = read_file('src/backend/snowball/snowball.sql.in'); - my $mf = read_file('src/backend/snowball/Makefile'); + my $mf = read_file('src/backend/snowball/Makefile'); $mf =~ s{\\\s*[\r\n]+}{}mg; $mf =~ /^LANGUAGES\s*=\s*(.*)$/m || die "Could not find LANGUAGES line in snowball Makefile\n"; - my @pieces = split /\s+/,$1; - open($F,">$target/share/snowball_create.sql") + my @pieces = split /\s+/, $1; + open($F, ">$target/share/snowball_create.sql") || die "Could not write snowball_create.sql"; print $F read_file('src/backend/snowball/snowball_func.sql.in'); while ($#pieces > 0) { - my $lang = shift @pieces || last; + my $lang = shift @pieces || last; my $asclang = shift @pieces || last; - my $txt = $tmpl; - my $stop = ''; + my $txt = $tmpl; + my $stop = ''; if (-s "src/backend/snowball/stopwords/$lang.stop") { @@ -361,9 +363,9 @@ sub CopyContribFiles { next if ($d =~ /^\./); next unless (-f "contrib/$d/Makefile"); - next if ($d eq "uuid-ossp"&& !defined($config->{uuid})); - next if ($d eq "sslinfo" && !defined($config->{openssl})); - next if ($d eq "xml2" && !defined($config->{xml})); + next if ($d eq "uuid-ossp" && !defined($config->{uuid})); + next if ($d eq "sslinfo" && !defined($config->{openssl})); + next if ($d eq "xml2" && !defined($config->{xml})); next if ($d eq "sepgsql"); my $mf = read_file("contrib/$d/Makefile"); @@ -373,32 +375,32 @@ sub CopyContribFiles my $moduledir = 'contrib'; my $flist = ''; - if ($mf =~ /^EXTENSION\s*=\s*(.*)$/m) {$flist .= $1} + if ($mf =~ /^EXTENSION\s*=\s*(.*)$/m) { $flist .= $1 } if ($flist ne '') { $moduledir = 'extension'; $flist = ParseAndCleanRule($flist, $mf); - foreach my $f (split /\s+/,$flist) + foreach my $f (split /\s+/, $flist) { lcopy( 'contrib/' . $d . '/' . $f . '.control', $target . '/share/extension/' . $f . '.control' - )|| croak("Could not copy file $f.control in contrib $d"); + ) || croak("Could not copy file $f.control in contrib $d"); print '.'; } } $flist = ''; - if ($mf =~ /^DATA_built\s*=\s*(.*)$/m) {$flist .= $1} - if ($mf =~ /^DATA\s*=\s*(.*)$/m) {$flist .= " $1"} - $flist =~ s/^\s*//; # Remove leading spaces if we had only DATA_built + if ($mf =~ /^DATA_built\s*=\s*(.*)$/m) { $flist .= $1 } + if ($mf =~ /^DATA\s*=\s*(.*)$/m) { $flist .= " $1" } + $flist =~ s/^\s*//; # Remove leading spaces if we had only DATA_built if ($flist ne '') { $flist = ParseAndCleanRule($flist, $mf); - foreach my $f (split /\s+/,$flist) + foreach my $f (split /\s+/, $flist) { lcopy('contrib/' . $d . '/' . $f, $target . '/share/' . $moduledir . '/' . basename($f)) @@ -408,12 +410,12 @@ sub CopyContribFiles } $flist = ''; - if ($mf =~ /^DATA_TSEARCH\s*=\s*(.*)$/m) {$flist .= $1} + if ($mf =~ /^DATA_TSEARCH\s*=\s*(.*)$/m) { $flist .= $1 } if ($flist ne '') { $flist = ParseAndCleanRule($flist, $mf); - foreach my $f (split /\s+/,$flist) + foreach my $f (split /\s+/, $flist) { lcopy('contrib/' . $d . '/' . $f, $target . '/share/tsearch_data/' . basename($f)) @@ -423,7 +425,7 @@ sub CopyContribFiles } $flist = ''; - if ($mf =~ /^DOCS\s*=\s*(.*)$/mg) {$flist .= $1} + if ($mf =~ /^DOCS\s*=\s*(.*)$/mg) { $flist .= $1 } if ($flist ne '') { $flist = ParseAndCleanRule($flist, $mf); @@ -432,7 +434,7 @@ sub CopyContribFiles $flist = "autoinc.example insert_username.example moddatetime.example refint.example timetravel.example" if ($d eq 'spi'); - foreach my $f (split /\s+/,$flist) + foreach my $f (split /\s+/, $flist) { lcopy('contrib/' . $d . '/' . $f, $target . '/doc/' . $moduledir . '/' . $f) @@ -448,20 +450,25 @@ sub CopyContribFiles sub ParseAndCleanRule { my $flist = shift; - my $mf = shift; + my $mf = shift; # Strip out $(addsuffix) rules if (index($flist, '$(addsuffix ') >= 0) { 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); + 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; } @@ -470,56 +477,52 @@ sub CopyIncludeFiles { my $target = shift; - EnsureDirectories($target, 'include', 'include/libpq','include/internal', - 'include/internal/libpq','include/server', 'include/server/parser'); + EnsureDirectories($target, 'include', 'include/libpq', 'include/internal', + 'include/internal/libpq', 'include/server', 'include/server/parser'); CopyFiles( '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' - ); + $target . '/include/internal/', + '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; @@ -533,47 +536,45 @@ sub CopyIncludeFiles EnsureDirectories("$target/include/server/$d"); system( qq{xcopy /s /i /q /r /y src\\include\\$d\\*.h "$ctarget\\include\\server\\$d\\"} - )&& croak("Failed to copy include directory $d\n"); + ) && croak("Failed to copy include directory $d\n"); } closedir($D); 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/', + $target . '/include/informix/esql/', 'src/interfaces/ecpg/include/', - split /\s+/,$1 - ); + split /\s+/, $1); } sub GenerateNLSFiles { - my $target = shift; - my $nlspath = shift; + my $target = shift; + my $nlspath = shift; my $majorver = shift; print "Installing NLS files..."; EnsureDirectories($target, "share/locale"); my @flist; File::Find::find( - { - wanted =>sub { + { wanted => sub { /^nls\.mk\z/s - &&!push(@flist, $File::Find::name); + && !push(@flist, $File::Find::name); } }, - "src" - ); + "src"); foreach (@flist) { my $prgm = DetermineCatalogName($_); @@ -590,7 +591,7 @@ sub GenerateNLSFiles "share/locale/$lang/LC_MESSAGES"); system( "\"$nlspath\\bin\\msgfmt\" -o \"$target\\share\\locale\\$lang\\LC_MESSAGES\\$prgm-$majorver.mo\" $_" - )&& croak("Could not run msgfmt on $dir\\$_"); + ) && croak("Could not run msgfmt on $dir\\$_"); print "."; } } @@ -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; diff --git a/src/tools/msvc/MSBuildProject.pm b/src/tools/msvc/MSBuildProject.pm index 4e6ea1f740..ac99345fa6 100644 --- a/src/tools/msvc/MSBuildProject.pm +++ b/src/tools/msvc/MSBuildProject.pm @@ -14,7 +14,7 @@ use base qw(Project); sub _new { my $classname = shift; - my $self = $classname->SUPER::_new(@_); + my $self = $classname->SUPER::_new(@_); bless($self, $classname); $self->{filenameExtension} = '.vcxproj'; @@ -40,8 +40,10 @@ EOF 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 < @@ -61,15 +63,17 @@ EOF EOF $self->WriteItemDefinitionGroup( $f, 'Debug', - { - defs=>'_DEBUG;DEBUG=1;', - opt=>'Disabled', - strpool=>'false', - runtime=>'MultiThreadedDebugDLL' - } - ); - $self->WriteItemDefinitionGroup($f, 'Release', - {defs=>'', opt=>'Full', strpool=>'true', runtime=>'MultiThreadedDLL'}); + { defs => '_DEBUG;DEBUG=1;', + opt => 'Disabled', + strpool => 'false', + runtime => 'MultiThreadedDebugDLL' }); + $self->WriteItemDefinitionGroup( + $f, + 'Release', + { defs => '', + opt => 'Full', + strpool => 'true', + runtime => 'MultiThreadedDLL' }); } sub AddDefine @@ -83,7 +87,7 @@ sub WriteReferences { my ($self, $f) = @_; - my @references = @{$self->{references}}; + my @references = @{ $self->{references} }; if (scalar(@references)) { @@ -110,14 +114,14 @@ sub WriteFiles print $f < EOF - my @grammarFiles = (); + my @grammarFiles = (); my @resourceFiles = (); my %uniquefiles; - foreach my $fileNameWithPath (sort keys %{$self->{files}}) + foreach my $fileNameWithPath (sort keys %{ $self->{files} }) { confess "Bad format filename '$fileNameWithPath'\n" unless ($fileNameWithPath =~ /^(.*)\\([^\\]+)\.[r]?[cyl]$/); - my $dir = $1; + my $dir = $1; my $fileName = $2; if ($fileNameWithPath =~ /\.y$/ or $fileNameWithPath =~ /\.l$/) { @@ -178,7 +182,7 @@ s{^src\\pl\\plpgsql\\src\\gram.c$}{src\\pl\\plpgsql\\src\\pl_gram.c}; EOF } - else #if ($grammarFile =~ /\.l$/) + else #if ($grammarFile =~ /\.l$/) { print $f < @@ -231,8 +235,8 @@ sub WriteConfigurationPropertyGroup my ($self, $f, $cfgname, $p) = @_; my $cfgtype = ($self->{type} eq "exe") - ?'Application' - :($self->{type} eq "dll"?'DynamicLibrary':'StaticLibrary'); + ? 'Application' + : ($self->{type} eq "dll" ? 'DynamicLibrary' : 'StaticLibrary'); print $f < @@ -269,11 +273,12 @@ sub WriteItemDefinitionGroup my ($self, $f, $cfgname, $p) = @_; my $cfgtype = ($self->{type} eq "exe") - ?'Application' - :($self->{type} eq "dll"?'DynamicLibrary':'StaticLibrary'); + ? 'Application' + : ($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 =~ /;$/) @@ -378,7 +383,7 @@ use base qw(MSBuildProject); sub new { my $classname = shift; - my $self = $classname->SUPER::_new(@_); + my $self = $classname->SUPER::_new(@_); bless($self, $classname); $self->{vcver} = '10.00'; diff --git a/src/tools/msvc/Mkvcbuild.pm b/src/tools/msvc/Mkvcbuild.pm index caecf4fd5f..845e36d20c 100644 --- a/src/tools/msvc/Mkvcbuild.pm +++ b/src/tools/msvc/Mkvcbuild.pm @@ -19,7 +19,7 @@ use List::Util qw(first); use Exporter; our (@ISA, @EXPORT_OK); -@ISA = qw(Exporter); +@ISA = qw(Exporter); @EXPORT_OK = qw(Mkvcbuild); my $solution; @@ -27,26 +27,29 @@ my $libpgport; my $postgres; my $libpq; -my $contrib_defines = {'refint' => 'REFINT_VERBOSE'}; -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' -); -my $contrib_extralibs = {'pgbench' => ['wsock32.lib']}; -my $contrib_extraincludes = {'tsearch2' => ['contrib/tsearch2'], 'dblink' => ['src/backend']}; +my $contrib_defines = { 'refint' => 'REFINT_VERBOSE' }; +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'); +my $contrib_extralibs = { 'pgbench' => ['wsock32.lib'] }; +my $contrib_extraincludes = + { 'tsearch2' => ['contrib/tsearch2'], 'dblink' => ['src/backend'] }; my $contrib_extrasource = { - 'cube' => ['cubescan.l','cubeparse.y'], - 'seg' => ['segscan.l','segparse.y'] -}; -my @contrib_excludes = ('pgcrypto','intagg','sepgsql'); + 'cube' => [ 'cubescan.l', 'cubeparse.y' ], + 'seg' => [ 'segscan.l', 'segparse.y' ] }; +my @contrib_excludes = ('pgcrypto', 'intagg', 'sepgsql'); 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(); @@ -60,24 +63,31 @@ sub mkvcbuild sprompt.c thread.c getopt.c getopt_long.c dirent.c rint.c win32env.c win32error.c win32setlocale.c); - $libpgport = $solution->AddProject('libpgport','lib','misc'); + $libpgport = $solution->AddProject('libpgport', 'lib', 'misc'); $libpgport->AddDefine('FRONTEND'); - $libpgport->AddFiles('src\port',@pgportfiles); + $libpgport->AddFiles('src\port', @pgportfiles); - $postgres = $solution->AddProject('postgres','exe','','src\backend'); + $postgres = $solution->AddProject('postgres', 'exe', '', 'src\backend'); $postgres->AddIncludeDir('src\backend'); $postgres->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->AddFiles('src\port',@pgportfiles); + $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\utils\misc','guc-file.l'); - $postgres->AddFiles('src\backend\replication', 'repl_scanner.l', 'repl_gram.y'); + $postgres->AddFiles('src\backend\parser', 'scan.l', 'gram.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->AddDefine('BUILDING_DLL'); $postgres->AddLibrary('wsock32.lib'); $postgres->AddLibrary('ws2_32.lib'); @@ -85,34 +95,36 @@ 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') { (my $xsc = $xs) =~ s/\.xs/.c/; - if (Solution::IsNewer("$plperlsrc$xsc","$plperlsrc$xs")) + if (Solution::IsNewer("$plperlsrc$xsc", "$plperlsrc$xs")) { my $xsubppdir = first { -e "$_\\ExtUtils\\xsubpp" } @INC; print "Building $plperlsrc$xsc...\n"; - system( $solution->{options}->{perl} + system( $solution->{options}->{perl} . '/bin/perl ' . "$xsubppdir/ExtUtils/xsubpp -typemap " . $solution->{options}->{perl} @@ -121,60 +133,58 @@ sub mkvcbuild . ">$plperlsrc$xsc"); if ((!(-f "$plperlsrc$xsc")) || -z "$plperlsrc$xsc") { - unlink("$plperlsrc$xsc"); # if zero size + unlink("$plperlsrc$xsc"); # if zero size die "Failed to create $xsc.\n"; } } } - 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' - ) - ) + || Solution::IsNewer( + 'src\pl\plperl\perlchunks.h', + 'src\pl\plperl\plc_trusted.pl')) { print 'Building src\pl\plperl\perlchunks.h ...' . "\n"; my $basedir = getcwd; chdir 'src\pl\plperl'; - system( $solution->{options}->{perl} + system( $solution->{options}->{perl} . '/bin/perl ' . 'text2macro.pl ' . '--strip="^(\#.*|\s*)$$" ' . 'plc_perlboot.pl plc_trusted.pl ' - . '>perlchunks.h'); + . '>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 + 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; chdir 'src\pl\plperl'; - system( $solution->{options}->{perl} + system( $solution->{options}->{perl} . '/bin/perl ' . 'plperl_opmask.pl ' - . 'plperl_opmask.h'); + . 'plperl_opmask.h'); chdir $basedir; if ((!(-f 'src\pl\plperl\plperl_opmask.h')) || -z 'src\pl\plperl\plperl_opmask.h') { - unlink('src\pl\plperl\plperl_opmask.h'); # if zero size + unlink('src\pl\plperl\plperl_opmask.h'); # if zero size die 'Failed to create plperl_opmask.h' . "\n"; } } $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,50 +251,56 @@ 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); + $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'); $libecpg->AddIncludeDir('src\port'); $libecpg->UseDef('src\interfaces\ecpg\ecpglib\ecpglib.def'); $libecpg->AddLibrary('wsock32.lib'); - $libecpg->AddReference($libpq,$pgtypes,$libpgport); + $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); + $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'); - $ecpg->AddFiles('src\interfaces\ecpg\preproc','pgc.l','preproc.y'); + $ecpg->AddFiles('src\interfaces\ecpg\preproc', 'pgc.l', 'preproc.y'); $ecpg->AddDefine('MAJOR_VERSION=4'); $ecpg->AddDefine('MINOR_VERSION=9'); $ecpg->AddDefine('PATCHLEVEL=0'); $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'); @@ -337,9 +359,10 @@ sub mkvcbuild my $pgreset = AddSimpleFrontend('pg_resetxlog'); - my $pgevent = $solution->AddProject('pgevent','dll','bin'); - $pgevent->AddFiles('src\bin\pgevent','pgevent.c','pgmsgevent.rc'); - $pgevent->AddResourceFile('src\bin\pgevent','Eventlog message formatter'); + 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->RemoveFile('src\bin\pgevent\win32ver.rc'); $pgevent->UseDef('src\bin\pgevent\pgevent.def'); $pgevent->DisableLinkerWarnings('4104'); @@ -363,9 +386,9 @@ sub mkvcbuild # pg_dump and pg_restore. # So remove their sources from the object, keeping the other setup that # AddSimpleFrontend() has done. - my @nodumpall = grep { m/src\\bin\\pg_dump\\.*\.c$/ } - keys %{$pgdumpall->{files}}; - delete @{$pgdumpall->{files}}{@nodumpall}; + my @nodumpall = grep { m/src\\bin\\pg_dump\\.*\.c$/ } + keys %{ $pgdumpall->{files} }; + delete @{ $pgdumpall->{files} }{@nodumpall}; $pgdumpall->{name} = 'pg_dumpall'; $pgdumpall->AddIncludeDir('src\backend'); $pgdumpall->AddFile('src\bin\pg_dump\pg_dumpall.c'); @@ -381,8 +404,9 @@ sub mkvcbuild $pgrestore->AddFile('src\bin\pg_dump\keywords.c'); $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'); + my $zic = $solution->AddProject('zic', 'exe', 'utils'); + $zic->AddFiles('src\timezone', 'zic.c', 'ialloc.c', 'scheck.c', + 'localtime.c'); $zic->AddReference($libpgport); if ($solution->{options}->{xml}) @@ -390,22 +414,20 @@ 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 { - push @contrib_excludes,'xml2'; + push @contrib_excludes, 'xml2'; } if (!$solution->{options}->{openssl}) { - push @contrib_excludes,'sslinfo'; + push @contrib_excludes, 'sslinfo'; } if ($solution->{options}->{uuid}) @@ -417,33 +439,38 @@ sub mkvcbuild } else { - push @contrib_excludes,'uuid-ossp'; + push @contrib_excludes, 'uuid-ossp'; } # Pgcrypto makefile too complex to parse.... - my $pgcrypto = $solution->AddProject('pgcrypto','dll','crypto'); + 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 { $pgcrypto->AddFiles( - 'contrib\pgcrypto', 'md5.c', - 'sha1.c','sha2.c', - 'internal.c','internal-sha2.c', - 'blf.c','rijndael.c', - 'fortuna.c','random.c', - 'pgp-mpi-internal.c','imath.c' - ); + 'contrib\pgcrypto', 'md5.c', + 'sha1.c', 'sha2.c', + 'internal.c', 'internal-sha2.c', + 'blf.c', 'rijndael.c', + 'fortuna.c', 'random.c', + 'pgp-mpi-internal.c', 'imath.c'); } $pgcrypto->AddReference($postgres); $pgcrypto->AddLibrary('wsock32.lib'); @@ -456,35 +483,43 @@ sub mkvcbuild { next if ($d =~ /^\./); next unless (-f "contrib/$d/Makefile"); - next if (grep {/^$d$/} @contrib_excludes); + next if (grep { /^$d$/ } @contrib_excludes); AddContrib($d); } closedir($D); - $mf = Project::read_file('src\backend\utils\mb\conversion_procs\Makefile'); + $mf = + Project::read_file('src\backend\utils\mb\conversion_procs\Makefile'); $mf =~ s{\\s*[\r\n]+}{}mg; - $mf =~ m{SUBDIRS\s*=\s*(.*)$}m || die 'Could not match in conversion makefile' . "\n"; - foreach my $sub (split /\s+/,$1) + $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"; - foreach my $prg (split /\s+/,$1) + $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"; - my @files = 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"; + my @files = split /\s+/, $1; foreach my $f (@files) { $f =~ s/\.o$/\.c/; @@ -501,7 +536,7 @@ sub mkvcbuild $proj->AddFile('src\bin\pg_dump\dumputils.c'); } elsif ($f =~ /print\.c$/) - { # Also catches mbprint.c + { # Also catches mbprint.c $proj->AddFile('src\bin\psql\\' . $f); } elsif ($f =~ /\.c$/) @@ -512,16 +547,16 @@ sub mkvcbuild $proj->AddIncludeDir('src\interfaces\libpq'); $proj->AddIncludeDir('src\bin\pg_dump'); $proj->AddIncludeDir('src\bin\psql'); - $proj->AddReference($libpq,$libpgport); - $proj->AddResourceFile('src\bin\scripts','PostgreSQL Utility'); + $proj->AddReference($libpq, $libpgport); + $proj->AddResourceFile('src\bin\scripts', 'PostgreSQL Utility'); } # Regression DLL and EXE - my $regress = $solution->AddProject('regress','dll','misc'); + my $regress = $solution->AddProject('regress', 'dll', 'misc'); $regress->AddFile('src\test\regress\regress.c'); $regress->AddReference($postgres); - my $pgregress = $solution->AddProject('pg_regress','exe','misc'); + my $pgregress = $solution->AddProject('pg_regress', 'exe', 'misc'); $pgregress->AddFile('src\test\regress\pg_regress.c'); $pgregress->AddFile('src\test\regress\pg_regress_main.c'); $pgregress->AddIncludeDir('src\port'); @@ -539,10 +574,10 @@ sub mkvcbuild # Add a simple frontend project (exe) sub AddSimpleFrontend { - my $n = shift; - my $uselibpq= shift; + my $n = shift; + my $uselibpq = shift; - my $p = $solution->AddProject($n,'exe','bin'); + my $p = $solution->AddProject($n, 'exe', 'bin'); $p->AddDir('src\bin\\' . $n); $p->AddReference($libpgport); if ($uselibpq) @@ -556,7 +591,7 @@ sub AddSimpleFrontend # Add a simple contrib project sub AddContrib { - my $n = shift; + my $n = shift; my $mf = Project::read_file('contrib\\' . $n . '\Makefile'); if ($mf =~ /^MODULE_big\s*=\s*(.*)$/mg) @@ -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) { @@ -630,7 +666,7 @@ sub AddContrib sub GenerateContribSqlFiles { - my $n = shift; + my $n = shift; my $mf = shift; if ($mf =~ /^DATA_built\s*=\s*(.*)$/mg) { @@ -645,25 +681,26 @@ sub GenerateContribSqlFiles { $pcount++ if (substr($l, $i, 1) eq '('); $pcount-- if (substr($l, $i, 1) eq ')'); - last if ($pcount < 0); + last if ($pcount < 0); } - $l = substr($l, 0, index($l, '$(addsuffix ')) . substr($l, $i+1); + $l = + substr($l, 0, index($l, '$(addsuffix ')) . substr($l, $i + 1); } foreach my $d (split /\s+/, $l) { - my $in = "$d.in"; + my $in = "$d.in"; my $out = "$d"; if (Solution::IsNewer("contrib/$n/$out", "contrib/$n/$in")) { print "Building $out from $in (contrib/$n)...\n"; my $cont = Project::read_file("contrib/$n/$in"); - my $dn = $out; - $dn =~ s/\.sql$//; + my $dn = $out; + $dn =~ s/\.sql$//; $cont =~ s/MODULE_PATHNAME/\$libdir\/$dn/g; my $o; - open($o,">contrib/$n/$out") + open($o, ">contrib/$n/$out") || croak "Could not write to contrib/$n/$d"; print $o $cont; close($o); @@ -675,7 +712,7 @@ sub GenerateContribSqlFiles sub AdjustContribProj { my $proj = shift; - my $n = $proj->{name}; + my $n = $proj->{name}; if ($contrib_defines->{$n}) { @@ -684,32 +721,32 @@ sub AdjustContribProj $proj->AddDefine($d); } } - if (grep {/^$n$/} @contrib_uselibpq) + if (grep { /^$n$/ } @contrib_uselibpq) { $proj->AddIncludeDir('src\interfaces\libpq'); $proj->AddReference($libpq); } - if (grep {/^$n$/} @contrib_uselibpgport) + if (grep { /^$n$/ } @contrib_uselibpgport) { $proj->AddReference($libpgport); } if ($contrib_extralibs->{$n}) { - foreach my $l (@{$contrib_extralibs->{$n}}) + foreach my $l (@{ $contrib_extralibs->{$n} }) { $proj->AddLibrary($l); } } if ($contrib_extraincludes->{$n}) { - foreach my $i (@{$contrib_extraincludes->{$n}}) + foreach my $i (@{ $contrib_extraincludes->{$n} }) { $proj->AddIncludeDir($i); } } if ($contrib_extrasource->{$n}) { - $proj->AddFiles('contrib\\' . $n, @{$contrib_extrasource->{$n}}); + $proj->AddFiles('contrib\\' . $n, @{ $contrib_extrasource->{$n} }); } } diff --git a/src/tools/msvc/Project.pm b/src/tools/msvc/Project.pm index 53cfdb1753..6f359bfdbc 100644 --- a/src/tools/msvc/Project.pm +++ b/src/tools/msvc/Project.pm @@ -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; @@ -50,11 +48,11 @@ sub AddFile sub AddFiles { my $self = shift; - my $dir = shift; + my $dir = shift; while (my $f = shift) { - $self->{files}->{$dir . "\\" . $f} = 1; + $self->{files}->{ $dir . "\\" . $f } = 1; } } @@ -63,7 +61,7 @@ sub ReplaceFile my ($self, $filename, $newname) = @_; my $re = "\\\\$filename\$"; - foreach my $file (keys %{$self->{files}}) + foreach my $file (keys %{ $self->{files} }) { # Match complete filename @@ -89,9 +87,9 @@ sub ReplaceFile sub RemoveFile { my ($self, $filename) = @_; - my $orig = scalar keys %{$self->{files}}; + my $orig = scalar keys %{ $self->{files} }; delete $self->{files}->{$filename}; - if ($orig > scalar keys %{$self->{files}}) + if ($orig > scalar keys %{ $self->{files} }) { return; } @@ -101,7 +99,7 @@ sub RemoveFile sub RelocateFiles { my ($self, $targetdir, $proc) = @_; - foreach my $f (keys %{$self->{files}}) + foreach my $f (keys %{ $self->{files} }) { my $r = &$proc($f); if ($r) @@ -118,8 +116,9 @@ sub AddReference while (my $ref = shift) { - push @{$self->{references}},$ref; - $self->AddLibrary("__CFGNAME__\\" . $ref->{name} . "\\" . $ref->{name} . ".lib"); + push @{ $self->{references} }, $ref; + $self->AddLibrary( + "__CFGNAME__\\" . $ref->{name} . "\\" . $ref->{name} . ".lib"); } } @@ -132,10 +131,10 @@ sub AddLibrary $lib = '"' . $lib . """; } - push @{$self->{libraries}}, $lib; + push @{ $self->{libraries} }, $lib; if ($dbgsuffix) { - push @{$self->{suffixlib}}, $lib; + push @{ $self->{suffixlib} }, $lib; } } @@ -170,8 +169,8 @@ sub FullExportDLL my ($self, $libname) = @_; $self->{builddef} = 1; - $self->{def} = ".\\__CFGNAME__\\$self->{name}\\$self->{name}.def"; - $self->{implib} = "__CFGNAME__\\$self->{name}\\$libname"; + $self->{def} = ".\\__CFGNAME__\\$self->{name}\\$self->{name}.def"; + $self->{implib} = "__CFGNAME__\\$self->{name}\\$libname"; } sub UseDef @@ -188,8 +187,8 @@ sub AddDir my $t = $/; undef $/; - open($MF,"$reldir\\Makefile") - || open($MF,"$reldir\\GNUMakefile") + open($MF, "$reldir\\Makefile") + || open($MF, "$reldir\\GNUMakefile") || croak "Could not open $reldir\\Makefile\n"; my $mf = <$MF>; close($MF); @@ -197,11 +196,11 @@ sub AddDir $mf =~ s{\\\s*[\r\n]+}{}mg; if ($mf =~ m{^(?:SUB)?DIRS[^=]*=\s*(.*)$}mg) { - foreach my $subdir (split /\s+/,$1) + foreach my $subdir (split /\s+/, $1) { next if $subdir eq "\$(top_builddir)/src/timezone" - ; #special case for non-standard include + ; #special case for non-standard include next if $reldir . "\\" . $subdir eq "src\\backend\\port\\darwin"; @@ -210,13 +209,13 @@ sub AddDir } while ($mf =~ m{^(?:EXTRA_)?OBJS[^=]*=\s*(.*)$}m) { - my $s = $1; + my $s = $1; my $filter_re = qr{\$\(filter ([^,]+),\s+\$\(([^\)]+)\)\)}; while ($s =~ /$filter_re/) { # Process $(filter a b c, $(VAR)) expressions - my $list = $1; + my $list = $1; my $filter = $2; $list =~ s/\.o/\.c/g; my @pieces = split /\s+/, $list; @@ -239,12 +238,13 @@ sub AddDir } $s =~ s/$filter_re/$matches/; } - foreach my $f (split /\s+/,$s) + foreach my $f (split /\s+/, $s) { 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,14 +264,15 @@ 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; - my $top = $2; + my $match = $1; + my $top = $2; my $target = $3; $target =~ s{/}{\\}g; - my @pieces = split /\s+/,$match; + my @pieces = split /\s+/, $match; foreach my $fn (@pieces) { if ($top eq "(top_srcdir)") @@ -296,7 +297,7 @@ sub AddDir my $desc = $1; my $ico; if ($mf =~ /^PGAPPICON\s*=\s*(.*)$/m) { $ico = $1; } - $self->AddResourceFile($reldir,$desc,$ico); + $self->AddResourceFile($reldir, $desc, $ico); } $/ = $t; } @@ -305,15 +306,18 @@ 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')) + 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"; - my $icostr = $ico?"IDI_ICON ICON \"src/port/$ico.ico\"":""; + 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 () { s/FILEDESC/"$desc"/gm; @@ -335,7 +339,8 @@ sub DisableLinkerWarnings { my ($self, $warnings) = @_; - $self->{disablelinkerwarnings} .= ',' unless ($self->{disablelinkerwarnings} eq ''); + $self->{disablelinkerwarnings} .= ',' + unless ($self->{disablelinkerwarnings} eq ''); $self->{disablelinkerwarnings} .= $warnings; } @@ -343,20 +348,21 @@ sub Save { my ($self) = @_; - # If doing DLL and haven't specified a DEF file, do a full export of all symbols - # in the project. +# If doing DLL and haven't specified a DEF file, do a full export of all symbols +# in the project. if ($self->{type} eq "dll" && !$self->{def}) { $self->FullExportDLL($self->{name} . ".lib"); } - # Warning 4197 is about double exporting, disable this per - # http://connect.microsoft.com/VisualStudio/feedback/ViewFeedback.aspx?FeedbackID=99193 +# Warning 4197 is about double exporting, disable this per +# http://connect.microsoft.com/VisualStudio/feedback/ViewFeedback.aspx?FeedbackID=99193 $self->DisableLinkerWarnings('4197') if ($self->{platform} eq 'x64'); # 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); @@ -366,12 +372,12 @@ sub Save sub GetAdditionalLinkerDependencies { my ($self, $cfgname, $seperator) = @_; - my $libcfg = (uc $cfgname eq "RELEASE")?"MD":"MDd"; + my $libcfg = (uc $cfgname eq "RELEASE") ? "MD" : "MDd"; my $libs = ''; - foreach my $lib (@{$self->{libraries}}) + foreach my $lib (@{ $self->{libraries} }) { my $xlib = $lib; - foreach my $slib (@{$self->{suffixlib}}) + foreach my $slib (@{ $self->{suffixlib} }) { if ($slib eq $lib) { diff --git a/src/tools/msvc/Solution.pm b/src/tools/msvc/Solution.pm index 0c50c05734..d6b79dcc29 100644 --- a/src/tools/msvc/Solution.pm +++ b/src/tools/msvc/Solution.pm @@ -13,15 +13,14 @@ use VSObjectFactory; sub _new { my $classname = shift; - my $options = shift; - my $self = { + my $options = shift; + my $self = { projects => {}, options => $options, numver => '', strver => '', vcver => undef, - platform => undef, - }; + platform => undef, }; bless($self, $classname); # integer_datetimes is now the default @@ -37,22 +36,23 @@ sub _new } } $options->{blocksize} = 8 - unless $options->{blocksize}; # undef or 0 means default + unless $options->{blocksize}; # undef or 0 means default die "Bad blocksize $options->{blocksize}" - unless grep {$_ == $options->{blocksize}} (1,2,4,8,16,32); + unless grep { $_ == $options->{blocksize} } (1, 2, 4, 8, 16, 32); $options->{segsize} = 1 - unless $options->{segsize}; # undef or 0 means default - # only allow segsize 1 for now, as we can't do large files yet in windows + unless $options->{segsize}; # undef or 0 means default + # only allow segsize 1 for now, as we can't do large files yet in windows die "Bad segsize $options->{segsize}" unless $options->{segsize} == 1; $options->{wal_blocksize} = 8 - unless $options->{wal_blocksize}; # undef or 0 means default + unless $options->{wal_blocksize}; # undef or 0 means default die "Bad wal_blocksize $options->{wal_blocksize}" - 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 + unless $options->{wal_segsize}; # undef or 0 means default die "Bad wal_segsize $options->{wal_segsize}" - unless grep {$_ == $options->{wal_segsize}} (1,2,4,8,16,32,64); + unless grep { $_ == $options->{wal_segsize} } (1, 2, 4, 8, 16, 32, 64); $self->DeterminePlatform(); @@ -66,7 +66,7 @@ sub DeterminePlatform # Determine if we are in 32 or 64-bit mode. Do this by seeing if CL has # 64-bit only parameters. $self->{platform} = 'Win32'; - open(P,"cl /? 2>NUL|") || die "cl command not found"; + open(P, "cl /? 2>NUL|") || die "cl command not found"; while (

) { if (/^\/favor:$dest") || croak "Could not open $dest"; + open(I, $src) || croak "Could not open $src"; + open(O, ">$dest") || croak "Could not open $dest"; while () { print O; @@ -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 () { if (/^AC_INIT\(\[PostgreSQL\], \[([^\]]+)\]/) @@ -131,7 +132,7 @@ sub GenerateFiles { confess "Bad format of version: $self->{strver}\n"; } - $self->{numver} = sprintf("%d%02d%02d", $1, $2, $3?$3:0); + $self->{numver} = sprintf("%d%02d%02d", $1, $2, $3 ? $3 : 0); $self->{majorver} = sprintf("%d.%d", $1, $2); } } @@ -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") + 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 () { s{PG_VERSION "[^"]+"}{PG_VERSION "$self->{strver}"}; @@ -159,22 +164,27 @@ 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}); - print O "#define HAVE_LIBZ 1\n" if ($self->{options}->{zlib}); - print O "#define USE_SSL 1\n" if ($self->{options}->{openssl}); + print O "#define USE_LDAP 1\n" if ($self->{options}->{ldap}); + print O "#define HAVE_LIBZ 1\n" if ($self->{options}->{zlib}); + print O "#define USE_SSL 1\n" if ($self->{options}->{openssl}); print O "#define ENABLE_NLS 1\n" if ($self->{options}->{nls}); - print O "#define BLCKSZ ",1024 * $self->{options}->{blocksize},"\n"; + print O "#define BLCKSZ ", 1024 * $self->{options}->{blocksize}, "\n"; print O "#define RELSEG_SIZE ", - (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 / $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"; if ($self->{options}->{float4byval}) @@ -225,40 +235,43 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY print O "#define DEF_PGPORT $port\n"; print O "#define DEF_PGPORT_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')) + if (IsNewer('src\include\utils\probes.h', 'src\backend\utils\probes.d')) { print "Generating probes.h...\n"; system( @@ -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') + 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 () { s/(VERSION.*),0/$1,$d/; @@ -322,7 +343,7 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY close(O); } - if (IsNewer('src\bin\psql\sql_help.h','src\bin\psql\create_help.pl')) + if (IsNewer('src\bin\psql\sql_help.h', 'src\bin\psql\create_help.pl')) { print "Generating sql_help.h...\n"; chdir('src\bin\psql'); @@ -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,15 +361,12 @@ 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') + open(O, '>', 'src\interfaces\ecpg\include\ecpg_config.h') || confess "Could not open ecpg_config.h"; print O < 1200) @@ -362,9 +382,9 @@ EOF unless (-f "src\\port\\pg_config_paths.h") { print "Generating pg_config_paths.h...\n"; - open(O,'>', 'src\port\pg_config_paths.h') + open(O, '>', 'src\port\pg_config_paths.h') || confess "Could not open pg_config_paths.h"; - print O <{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 <{strver}"> {majorver}"> @@ -414,13 +438,13 @@ EOF sub GenerateDefFile { - my ($self, $deffile, $txtfile, $libname) = @_; + my ($self, $deffile, $txtfile, $libname) = @_; - if (IsNewer($deffile,$txtfile)) + if (IsNewer($deffile, $txtfile)) { print "Generating $deffile...\n"; - open(I,$txtfile) || confess("Could not open $txtfile\n"); - open(O,">$deffile") || confess("Could not open $deffile\n"); + open(I, $txtfile) || confess("Could not open $txtfile\n"); + open(O, ">$deffile") || confess("Could not open $deffile\n"); print O "LIBRARY $libname\nEXPORTS\n"; while () { @@ -438,8 +462,9 @@ sub AddProject { my ($self, $name, $type, $folder, $initialdir) = @_; - my $proj = VSObjectFactory::CreateProject($self->{vcver}, $name, $type, $self); - push @{$self->{projects}->{$folder}}, $proj; + 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}) { @@ -488,23 +517,23 @@ sub Save my %flduid; $self->GenerateFiles(); - foreach my $fld (keys %{$self->{projects}}) + foreach my $fld (keys %{ $self->{projects} }) { - foreach my $proj (@{$self->{projects}->{$fld}}) + foreach my $proj (@{ $self->{projects}->{$fld} }) { $proj->Save(); } } - open(SLN,">pgsql.sln") || croak "Could not write to pgsql.sln\n"; + open(SLN, ">pgsql.sln") || croak "Could not write to pgsql.sln\n"; print SLN <{solutionFileVersion} # $self->{visualStudioName} EOF - foreach my $fld (keys %{$self->{projects}}) + foreach my $fld (keys %{ $self->{projects} }) { - foreach my $proj (@{$self->{projects}->{$fld}}) + foreach my $proj (@{ $self->{projects}->{$fld} }) { print SLN <{name}$proj->{filenameExtension}", "$proj->{guid}" @@ -530,9 +559,9 @@ Global GlobalSection(ProjectConfigurationPlatforms) = postSolution EOF - foreach my $fld (keys %{$self->{projects}}) + foreach my $fld (keys %{ $self->{projects} }) { - foreach my $proj (@{$self->{projects}->{$fld}}) + foreach my $proj (@{ $self->{projects}->{$fld} }) { print SLN <{guid}.Debug|$self->{platform}.ActiveCfg = Debug|$self->{platform} @@ -551,10 +580,10 @@ EOF GlobalSection(NestedProjects) = preSolution EOF - foreach my $fld (keys %{$self->{projects}}) + foreach my $fld (keys %{ $self->{projects} }) { next if ($fld eq ""); - foreach my $proj (@{$self->{projects}->{$fld}}) + foreach my $proj (@{ $self->{projects}->{$fld} }) { print SLN "\t\t$proj->{guid} = $flduid{$fld}\n"; } @@ -573,18 +602,19 @@ 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 .= ' --with-ldap' if ($self->{options}->{ldap}); $cfg .= ' --without-zlib' unless ($self->{options}->{zlib}); - $cfg .= ' --with-openssl' if ($self->{options}->{ssl}); + $cfg .= ' --with-openssl' if ($self->{options}->{ssl}); $cfg .= ' --with-ossp-uuid' if ($self->{options}->{uuid}); - $cfg .= ' --with-libxml' if ($self->{options}->{xml}); - $cfg .= ' --with-libxslt' if ($self->{options}->{xslt}); - $cfg .= ' --with-krb5' if ($self->{options}->{krb5}); - $cfg .= ' --with-tcl' if ($self->{options}->{tcl}); - $cfg .= ' --with-perl' if ($self->{options}->{perl}); - $cfg .= ' --with-python' if ($self->{options}->{python}); + $cfg .= ' --with-libxml' if ($self->{options}->{xml}); + $cfg .= ' --with-libxslt' if ($self->{options}->{xslt}); + $cfg .= ' --with-krb5' if ($self->{options}->{krb5}); + $cfg .= ' --with-tcl' if ($self->{options}->{tcl}); + $cfg .= ' --with-perl' if ($self->{options}->{perl}); + $cfg .= ' --with-python' if ($self->{options}->{python}); return $cfg; } @@ -602,12 +632,12 @@ use base qw(Solution); sub new { my $classname = shift; - my $self = $classname->SUPER::_new(@_); + my $self = $classname->SUPER::_new(@_); bless($self, $classname); $self->{solutionFileVersion} = '9.00'; - $self->{vcver} = '8.00'; - $self->{visualStudioName} = 'Visual Studio 2005'; + $self->{vcver} = '8.00'; + $self->{visualStudioName} = 'Visual Studio 2005'; return $self; } @@ -625,12 +655,12 @@ use base qw(Solution); sub new { my $classname = shift; - my $self = $classname->SUPER::_new(@_); + my $self = $classname->SUPER::_new(@_); bless($self, $classname); $self->{solutionFileVersion} = '10.00'; - $self->{vcver} = '9.00'; - $self->{visualStudioName} = 'Visual Studio 2008'; + $self->{vcver} = '9.00'; + $self->{visualStudioName} = 'Visual Studio 2008'; return $self; } @@ -649,12 +679,12 @@ use base qw(Solution); sub new { my $classname = shift; - my $self = $classname->SUPER::_new(@_); + my $self = $classname->SUPER::_new(@_); bless($self, $classname); $self->{solutionFileVersion} = '11.00'; - $self->{vcver} = '10.00'; - $self->{visualStudioName} = 'Visual Studio 2010'; + $self->{vcver} = '10.00'; + $self->{visualStudioName} = 'Visual Studio 2010'; return $self; } diff --git a/src/tools/msvc/VCBuildProject.pm b/src/tools/msvc/VCBuildProject.pm index a7fd0c0d9d..1022329dce 100644 --- a/src/tools/msvc/VCBuildProject.pm +++ b/src/tools/msvc/VCBuildProject.pm @@ -14,7 +14,7 @@ use base qw(Project); sub _new { my $classname = shift; - my $self = $classname->SUPER::_new(@_); + my $self = $classname->SUPER::_new(@_); bless($self, $classname); $self->{filenameExtension} = '.vcproj'; @@ -32,10 +32,21 @@ sub WriteHeader 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 @@ -50,43 +61,49 @@ sub WriteFiles EOF my @dirstack = (); my %uniquefiles; - foreach my $fileNameWithPath (sort keys %{$self->{files}}) + foreach my $fileNameWithPath (sort keys %{ $self->{files} }) { confess "Bad format filename '$fileNameWithPath'\n" unless ($fileNameWithPath =~ /^(.*)\\([^\\]+)\.[r]?[cyl]$/); - my $dir = $1; + my $dir = $1; my $file = $2; - # Walk backwards down the directory stack and close any dirs we're done with + # Walk backwards down the directory stack and close any dirs we're done with while ($#dirstack >= 0) { - 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 (length($dir) == length(join('\\', @dirstack))); + last + if (substr($dir, length(join('\\', @dirstack)), 1) eq '\\'); } print $f ' ' x $#dirstack . " \n"; pop @dirstack; } # Now walk forwards and create whatever directories are needed - while (join('\\',@dirstack) ne $dir) + while (join('\\', @dirstack) ne $dir) { - my $left = substr($dir, length(join('\\',@dirstack))); + my $left = substr($dir, length(join('\\', @dirstack))); $left =~ s/^\\//; my @pieces = split /\\/, $left; push @dirstack, $pieces[0]; - print $f ' ' x $#dirstack . " \n"; + print $f ' ' x $#dirstack + . " \n"; } - print $f ' ' x $#dirstack . " ' - . $self->GenerateCustomTool('Running bison on ' . $fileNameWithPath, + . $self->GenerateCustomTool( + 'Running bison on ' . $fileNameWithPath, "perl src\\tools\\msvc\\pgbison.pl $fileNameWithPath", $of) . '' . "\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) . '' . "\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}) { @@ -202,7 +222,7 @@ sub WriteReferences { my ($self, $f) = @_; print $f " \n"; - foreach my $ref (@{$self->{references}}) + foreach my $ref (@{ $self->{references} }) { print $f " {guid}\" Name=\"$ref->{name}\" />\n"; @@ -216,7 +236,7 @@ sub GenerateCustomTool if (!defined($cfg)) { return $self->GenerateCustomTool($desc, $tool, $output, 'Debug') - .$self->GenerateCustomTool($desc, $tool, $output, 'Release'); + . $self->GenerateCustomTool($desc, $tool, $output, 'Release'); } return "{platform}\">"; @@ -235,7 +255,7 @@ use base qw(VCBuildProject); sub new { my $classname = shift; - my $self = $classname->SUPER::_new(@_); + my $self = $classname->SUPER::_new(@_); bless($self, $classname); $self->{vcver} = '8.00'; @@ -256,7 +276,7 @@ use base qw(VCBuildProject); sub new { my $classname = shift; - my $self = $classname->SUPER::_new(@_); + my $self = $classname->SUPER::_new(@_); bless($self, $classname); $self->{vcver} = '9.00'; diff --git a/src/tools/msvc/VSObjectFactory.pm b/src/tools/msvc/VSObjectFactory.pm index e222b04c68..c3aa33ec24 100644 --- a/src/tools/msvc/VSObjectFactory.pm +++ b/src/tools/msvc/VSObjectFactory.pm @@ -17,7 +17,7 @@ use VCBuildProject; use MSBuildProject; our (@ISA, @EXPORT); -@ISA = qw(Exporter); +@ISA = qw(Exporter); @EXPORT = qw(CreateSolution CreateProject DetermineVisualStudioVersion); sub CreateSolution @@ -81,12 +81,12 @@ sub DetermineVisualStudioVersion if (!defined($nmakeVersion)) { - # Determine version of nmake command, to set proper version of visual studio - # we use nmake as it has existed for a long time and still exists in visual studio 2010 - open(P,"nmake /? 2>&1 |") +# Determine version of nmake command, to set proper version of visual studio +# we use nmake as it has existed for a long time and still exists in visual studio 2010 + open(P, "nmake /? 2>&1 |") || croak - "Unable to determine Visual Studio version: The nmake command wasn't found."; - while(

) +"Unable to determine Visual Studio version: The nmake command wasn't found."; + while (

) { chomp; if (/(\d+)\.(\d+)\.\d+(\.\d+)?$/) @@ -96,17 +96,17 @@ sub DetermineVisualStudioVersion } close(P); } - elsif($nmakeVersion =~ /(\d+)\.(\d+)\.\d+(\.\d+)?$/) + elsif ($nmakeVersion =~ /(\d+)\.(\d+)\.\d+(\.\d+)?$/) { return _GetVisualStudioVersion($1, $2); } croak - "Unable to determine Visual Studio version: The nmake version could not be determined."; +"Unable to determine Visual Studio version: The nmake version could not be determined."; } sub _GetVisualStudioVersion { - my($major, $minor) = @_; + my ($major, $minor) = @_; if ($major > 10) { carp diff --git a/src/tools/msvc/build.pl b/src/tools/msvc/build.pl index 4fa309738b..8979402d4c 100644 --- a/src/tools/msvc/build.pl +++ b/src/tools/msvc/build.pl @@ -5,7 +5,7 @@ BEGIN { - chdir("../../..") if (-d "../msvc" && -d "../../../src"); + chdir("../../..") if (-d "../msvc" && -d "../../../src"); } @@ -37,8 +37,8 @@ my $vcver = Mkvcbuild::mkvcbuild($config); # check what sort of build we are doing -my $bconf = $ENV{CONFIG} || "Release"; -my $buildwhat = $ARGV[1] || ""; +my $bconf = $ENV{CONFIG} || "Release"; +my $buildwhat = $ARGV[1] || ""; if ($ARGV[0] eq 'DEBUG') { $bconf = "Debug"; @@ -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) { diff --git a/src/tools/msvc/builddoc.pl b/src/tools/msvc/builddoc.pl index b567f542a7..2b56ced43c 100644 --- a/src/tools/msvc/builddoc.pl +++ b/src/tools/msvc/builddoc.pl @@ -9,10 +9,10 @@ use strict; use File::Copy; use Cwd qw(abs_path getcwd); -my $startdir = getcwd(); +my $startdir = getcwd(); my $openjade = 'openjade-1.3.1'; -my $dsssl = 'docbook-dsssl-1.79'; +my $dsssl = 'docbook-dsssl-1.79'; chdir '../../..' if (-d '../msvc' && -d '../../../src'); @@ -26,7 +26,7 @@ die "bad DOCROOT '$docroot'" unless ($docroot && -d $docroot); my @notfound; foreach my $dir ('docbook', $openjade, $dsssl) { - push(@notfound,$dir) unless -d "$docroot/$dir"; + push(@notfound, $dir) unless -d "$docroot/$dir"; } missing() if @notfound; @@ -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; @@ -43,45 +44,46 @@ my $cmd; # can't die on "failure" $cmd = - "perl mk_feature_tables.pl YES " - ."../../../src/backend/catalog/sql_feature_packages.txt " - ."../../../src/backend/catalog/sql_features.txt " - ."> features-supported.sgml"; + "perl mk_feature_tables.pl YES " + . "../../../src/backend/catalog/sql_feature_packages.txt " + . "../../../src/backend/catalog/sql_features.txt " + . "> features-supported.sgml"; system($cmd); die "features_supported" if $?; $cmd = - "perl mk_feature_tables.pl NO " - ."\"../../../src/backend/catalog/sql_feature_packages.txt\" " - ."\"../../../src/backend/catalog/sql_features.txt\" " - ."> features-unsupported.sgml"; + "perl mk_feature_tables.pl NO " + . "\"../../../src/backend/catalog/sql_feature_packages.txt\" " + . "\"../../../src/backend/catalog/sql_features.txt\" " + . "> features-unsupported.sgml"; system($cmd); die "features_unsupported" if $?; -$cmd ="perl generate-errcodes-table.pl \"../../../src/backend/utils/errcodes.txt\" " - ."> errcodes-table.sgml"; +$cmd = +"perl generate-errcodes-table.pl \"../../../src/backend/utils/errcodes.txt\" " + . "> errcodes-table.sgml"; system($cmd); die "errcodes-table" if $?; print "Running first build...\n"; $cmd = - "\"$docroot/$openjade/bin/openjade\" -V html-index -wall " - ."-wno-unused-param -wno-empty -D . -c \"$docroot/$dsssl/catalog\" " - ."-d stylesheet.dsl -i output-html -t sgml postgres.sgml 2>&1 " - ."| findstr /V \"DTDDECL catalog entries are not supported\" "; -system($cmd); # die "openjade" if $?; + "\"$docroot/$openjade/bin/openjade\" -V html-index -wall " + . "-wno-unused-param -wno-empty -D . -c \"$docroot/$dsssl/catalog\" " + . "-d stylesheet.dsl -i output-html -t sgml postgres.sgml 2>&1 " + . "| 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"; print "Running second build...\n"; $cmd = - "\"$docroot/$openjade/bin/openjade\" -wall -wno-unused-param -wno-empty " - ."-D . -c \"$docroot/$dsssl/catalog\" -d stylesheet.dsl -t sgml " - ."-i output-html -i include-index postgres.sgml 2>&1 " - ."| findstr /V \"DTDDECL catalog entries are not supported\" "; + "\"$docroot/$openjade/bin/openjade\" -wall -wno-unused-param -wno-empty " + . "-D . -c \"$docroot/$dsssl/catalog\" -d stylesheet.dsl -t sgml " + . "-i output-html -i include-index postgres.sgml 2>&1 " + . "| findstr /V \"DTDDECL catalog entries are not supported\" "; -system($cmd); # die "openjade" if $?; +system($cmd); # die "openjade" if $?; copy "stylesheet.css", "html/stylesheet.css"; @@ -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; } diff --git a/src/tools/msvc/config_default.pl b/src/tools/msvc/config_default.pl index 95e9cd93da..2489d3827f 100644 --- a/src/tools/msvc/config_default.pl +++ b/src/tools/msvc/config_default.pl @@ -3,25 +3,25 @@ use strict; use warnings; our $config = { - asserts=>0, # --enable-cassert - # integer_datetimes=>1, # --enable-integer-datetimes - on is now default - # float4byval=>1, # --disable-float4-byval, on by default - # float8byval=>0, # --disable-float8-byval, off by default - # blocksize => 8, # --with-blocksize, 8kB by default - # wal_blocksize => 8, # --with-wal-blocksize, 8kB by default - # wal_segsize => 16, # --with-wal-segsize, 16MB by default - ldap=>1, # --with-ldap - nls=>undef, # --enable-nls= - tcl=>undef, # --with-tls= - perl=>undef, # --with-perl - python=>undef, # --with-python= - krb5=>undef, # --with-krb5= - openssl=>undef, # --with-ssl= - uuid=>undef, # --with-ossp-uuid - xml=>undef, # --with-libxml= - xslt=>undef, # --with-libxslt= - iconv=>undef, # (not in configure, path to iconv) - zlib=>undef # --with-zlib= + asserts => 0, # --enable-cassert + # integer_datetimes=>1, # --enable-integer-datetimes - on is now default + # float4byval=>1, # --disable-float4-byval, on by default + # float8byval=>0, # --disable-float8-byval, off by default + # blocksize => 8, # --with-blocksize, 8kB by default + # wal_blocksize => 8, # --with-wal-blocksize, 8kB by default + # wal_segsize => 16, # --with-wal-segsize, 16MB by default + ldap => 1, # --with-ldap + nls => undef, # --enable-nls= + tcl => undef, # --with-tls= + perl => undef, # --with-perl + python => undef, # --with-python= + krb5 => undef, # --with-krb5= + openssl => undef, # --with-ssl= + uuid => undef, # --with-ossp-uuid + xml => undef, # --with-libxml= + xslt => undef, # --with-libxslt= + iconv => undef, # (not in configure, path to iconv) + zlib => undef # --with-zlib= }; 1; diff --git a/src/tools/msvc/gendef.pl b/src/tools/msvc/gendef.pl index 2fc8c4a290..ab65c46cfa 100644 --- a/src/tools/msvc/gendef.pl +++ b/src/tools/msvc/gendef.pl @@ -7,8 +7,9 @@ my @def; # die "Usage: gendef.pl \n" - unless(($ARGV[0] =~ /\\([^\\]+$)/) && ($ARGV[1] == 'Win32' || $ARGV[1] == 'x64')); -my $defname = uc $1; + unless (($ARGV[0] =~ /\\([^\\]+$)/) + && ($ARGV[1] == 'Win32' || $ARGV[1] == 'x64')); +my $defname = uc $1; my $platform = $ARGV[1]; if (-f "$ARGV[0]/$defname.def") @@ -22,9 +23,10 @@ print "Generating $defname.DEF from directory $ARGV[0], platform $platform\n"; while (<$ARGV[0]/*.obj>) { my $symfile = $_; - $symfile=~ s/\.obj$/.sym/i; + $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, ") { @@ -46,19 +48,20 @@ while (<$ARGV[0]/*.obj>) push @def, $pieces[6]; } close(F); - rename("symbols.out",$symfile); + rename("symbols.out", $symfile); } print "\n"; -open(DEF,">$ARGV[0]/$defname.def") || die "Could not write to $defname\n"; +open(DEF, ">$ARGV[0]/$defname.def") || die "Could not write to $defname\n"; print DEF "EXPORTS\n"; -my $i = 0; +my $i = 0; my $last = ""; 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? diff --git a/src/tools/msvc/mkvcbuild.pl b/src/tools/msvc/mkvcbuild.pl index 32861cbbd6..6f1c42e504 100644 --- a/src/tools/msvc/mkvcbuild.pl +++ b/src/tools/msvc/mkvcbuild.pl @@ -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'; diff --git a/src/tools/msvc/pgbison.pl b/src/tools/msvc/pgbison.pl index f0c9e26007..d6f2444841 100644 --- a/src/tools/msvc/pgbison.pl +++ b/src/tools/msvc/pgbison.pl @@ -9,8 +9,8 @@ use File::Basename; require 'src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl'; -my ($bisonver) = `bison -V`; # grab first line -$bisonver=(split(/\s+/,$bisonver))[3]; # grab version number +my ($bisonver) = `bison -V`; # grab first line +$bisonver = (split(/\s+/, $bisonver))[3]; # grab version number unless ($bisonver eq '1.875' || $bisonver ge '2.2') { @@ -38,9 +38,9 @@ $output =~ s/gram\.c$/pl_gram.c/ if $input =~ /src.pl.plpgsql.src.gram\.y$/; my $makefile = dirname($input) . "/Makefile"; my ($mf, $make); -open($mf,$makefile); +open($mf, $makefile); local $/ = undef; -$make=<$mf>; +$make = <$mf>; close($mf); my $headerflag = ($make =~ /\$\(BISON\)\s+-d/ ? '-d' : ''); diff --git a/src/tools/msvc/pgflex.pl b/src/tools/msvc/pgflex.pl index 551b8f67ae..259f2187ed 100644 --- a/src/tools/msvc/pgflex.pl +++ b/src/tools/msvc/pgflex.pl @@ -12,10 +12,10 @@ use File::Basename; require 'src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl'; -my ($flexver) = `flex -V`; # grab first line -$flexver=(split(/\s+/,$flexver))[1]; +my ($flexver) = `flex -V`; # grab first line +$flexver = (split(/\s+/, $flexver))[1]; $flexver =~ s/[^0-9.]//g; -my @verparts = split(/\./,$flexver); +my @verparts = split(/\./, $flexver); unless ($verparts[0] == 2 && $verparts[1] == 5 && $verparts[2] >= 31) { print "WARNING! Flex install not found, or unsupported Flex version.\n"; @@ -40,9 +40,9 @@ elsif (!-e $input) # get flex flags from make file my $makefile = dirname($input) . "/Makefile"; my ($mf, $make); -open($mf,$makefile); +open($mf, $makefile); local $/ = undef; -$make=<$mf>; +$make = <$mf>; close($mf); my $flexflags = ($make =~ /^\s*FLEXFLAGS\s*=\s*(\S.*)/m ? $1 : ''); @@ -55,24 +55,24 @@ if ($? == 0) # For reentrant scanners (like the core scanner) we do not # need to (and must not) change the yywrap definition. my $lfile; - open($lfile,$input) || die "opening $input for reading: $!"; + open($lfile, $input) || die "opening $input for reading: $!"; my $lcode = <$lfile>; close($lfile); if ($lcode !~ /\%option\sreentrant/) { my $cfile; - open($cfile,$output) || die "opening $output for reading: $!"; + open($cfile, $output) || die "opening $output for reading: $!"; my $ccode = <$cfile>; close($cfile); $ccode =~ s/yywrap\(n\)/yywrap()/; - open($cfile,">$output") || die "opening $output for reading: $!"; + open($cfile, ">$output") || die "opening $output for reading: $!"; print $cfile $ccode; close($cfile); } if ($flexflags =~ /\s-b\s/) { my $lexback = "lex.backup"; - open($lfile,$lexback) || die "opening $lexback for reading: $!"; + open($lfile, $lexback) || die "opening $lexback for reading: $!"; my $lexbacklines = <$lfile>; close($lfile); my $linecount = $lexbacklines =~ tr /\n/\n/; diff --git a/src/tools/msvc/vcregress.pl b/src/tools/msvc/vcregress.pl index ef7035068b..530770ced3 100644 --- a/src/tools/msvc/vcregress.pl +++ b/src/tools/msvc/vcregress.pl @@ -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; } @@ -38,10 +39,10 @@ else # use a capital C here because config.pl has $config my $Config = -e "release/postgres/postgres.exe" ? "Release" : "Debug"; -copy("$Config/refint/refint.dll","src/test/regress"); -copy("$Config/autoinc/autoinc.dll","src/test/regress"); -copy("$Config/regress/regress.dll","src/test/regress"); -copy("$Config/dummy_seclabel/dummy_seclabel.dll","src/test/regress"); +copy("$Config/refint/refint.dll", "src/test/regress"); +copy("$Config/autoinc/autoinc.dll", "src/test/regress"); +copy("$Config/regress/regress.dll", "src/test/regress"); +copy("$Config/dummy_seclabel/dummy_seclabel.dll", "src/test/regress"); $ENV{PATH} = "../../../$Config/libpq;../../$Config/libpq;$ENV{PATH}"; @@ -67,13 +68,12 @@ $temp_config = "--temp-config=\"$ENV{TEMP_CONFIG}\"" chdir "src/test/regress"; my %command = ( - CHECK => \&check, - PLCHECK => \&plcheck, - INSTALLCHECK => \&installcheck, - ECPGCHECK => \&ecpgcheck, - CONTRIBCHECK => \&contribcheck, - ISOLATIONCHECK => \&isolationcheck, -); + CHECK => \&check, + PLCHECK => \&plcheck, + INSTALLCHECK => \&installcheck, + ECPGCHECK => \&ecpgcheck, + CONTRIBCHECK => \&contribcheck, + ISOLATIONCHECK => \&isolationcheck,); my $proc = $command{$what}; @@ -88,28 +88,33 @@ exit 0; sub installcheck { my @args = ( - "../../../$Config/pg_regress/pg_regress","--dlpath=.", - "--psqldir=../../../$Config/psql","--schedule=${schedule}_schedule", - "--encoding=SQL_ASCII","--no-locale" - ); - push(@args,$maxconn) if $maxconn; + "../../../$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; + my $status = $? >> 8; exit $status if $status; } 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\"" - ); - push(@args,$maxconn) if $maxconn; - push(@args,$temp_config) if $temp_config; + "../../../$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); - my $status = $? >>8; + my $status = $? >> 8; exit $status if $status; } @@ -117,10 +122,10 @@ sub ecpgcheck { chdir $startdir; system("msbuild ecpg_regression.proj /p:config=$Config"); - my $status = $? >>8; + my $status = $? >> 8; exit $status if $status; chdir "$topdir/src/interfaces/ecpg/test"; - $schedule="ecpg"; + $schedule = "ecpg"; my @args = ( "../../../../$Config/pg_regress_ecpg/pg_regress_ecpg", "--psqldir=../../../$Config/psql", @@ -130,26 +135,25 @@ sub ecpgcheck "--encoding=SQL_ASCII", "--no-locale", "--temp-install=./tmp_chk", - "--top-builddir=\"$topdir\"" - ); - push(@args,$maxconn) if $maxconn; + "--top-builddir=\"$topdir\""); + push(@args, $maxconn) if $maxconn; system(@args); - $status = $? >>8; + $status = $? >> 8; exit $status if $status; } sub isolationcheck { chdir "../isolation"; - copy("../../../$Config/isolationtester/isolationtester.exe","."); + copy("../../../$Config/isolationtester/isolationtester.exe", "."); my @args = ( "../../../$Config/pg_isolation_regress/pg_isolation_regress", "--psqldir=../../../$Config/psql", - "--inputdir=.","--schedule=./isolation_schedule" - ); - push(@args,$maxconn) if $maxconn; + "--inputdir=.", + "--schedule=./isolation_schedule"); + push(@args, $maxconn) if $maxconn; system(@args); - my $status = $? >>8; + my $status = $? >> 8; exit $status if $status; } @@ -178,16 +182,16 @@ sub plcheck use Config; if ($Config{usemultiplicity} eq 'define') { - push(@tests,'plperl_plperlu'); + 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; @@ -207,18 +211,18 @@ sub contribcheck next if ($module eq 'xml2' && !$config->{xml}); next unless -d "$module/sql" - &&-d "$module/expected" - &&(-f "$module/GNUmakefile" || -f "$module/Makefile"); + && -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 = ( + 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; @@ -230,10 +234,10 @@ sub contribcheck sub fetchRegressOpts { my $handle; - open($handle,"; close($handle); my @opts; @@ -242,7 +246,7 @@ sub fetchRegressOpts # ignore options that use makefile variables - can't handle those # ignore anything that isn't an option staring with -- - @opts = grep { $_ !~ /\$\(/ && $_ =~ /^--/ } split(/\s+/,$1); + @opts = grep { $_ !~ /\$\(/ && $_ =~ /^--/ } split(/\s+/, $1); } if ($m =~ /^\s*ENCODING\s*=\s*(\S+)/m) { @@ -259,10 +263,10 @@ sub fetchTests { my $handle; - open($handle,"; close($handle); my $t = ""; @@ -281,24 +285,24 @@ sub fetchTests my $cftests = $config->{openssl} - ?GetTests("OSSL_TESTS",$m) - : GetTests("INT_TESTS",$m); + ? GetTests("OSSL_TESTS", $m) + : GetTests("INT_TESTS", $m); my $pgptests = $config->{zlib} - ?GetTests("ZLIB_TST",$m) - : GetTests("ZLIB_OFF_TST",$m); + ? GetTests("ZLIB_TST", $m) + : GetTests("ZLIB_OFF_TST", $m); $t =~ s/\$\(CF_TESTS\)/$cftests/; $t =~ s/\$\(CF_PGP_TESTS\)/$pgptests/; } } - return split(/\s+/,$t); + return split(/\s+/, $t); } sub GetTests { my $testname = shift; - my $m = shift; + my $m = shift; if ($m =~ /^$testname\s*=\s*(.*)$/gm) { return $1; diff --git a/src/tools/version_stamp.pl b/src/tools/version_stamp.pl index 5ec5def49e..8850714e70 100755 --- a/src/tools/version_stamp.pl +++ b/src/tools/version_stamp.pl @@ -29,31 +29,45 @@ $major2 = 3; $minor = shift; defined($minor) || die "$0: missing required argument: minor-version\n"; -if ($minor =~ m/^\d+$/) { - $dotneeded = 1; - $numericminor = $minor; -} elsif ($minor eq "devel") { - $dotneeded = 0; - $numericminor = 0; -} elsif ($minor =~ m/^alpha\d+$/) { - $dotneeded = 0; - $numericminor = 0; -} elsif ($minor =~ m/^beta\d+$/) { - $dotneeded = 0; - $numericminor = 0; -} elsif ($minor =~ m/^rc\d+$/) { - $dotneeded = 0; - $numericminor = 0; -} else { - die "$0: minor-version must be N, devel, alphaN, betaN, or rcN\n"; +if ($minor =~ m/^\d+$/) +{ + $dotneeded = 1; + $numericminor = $minor; +} +elsif ($minor eq "devel") +{ + $dotneeded = 0; + $numericminor = 0; +} +elsif ($minor =~ m/^alpha\d+$/) +{ + $dotneeded = 0; + $numericminor = 0; +} +elsif ($minor =~ m/^beta\d+$/) +{ + $dotneeded = 0; + $numericminor = 0; +} +elsif ($minor =~ m/^rc\d+$/) +{ + $dotneeded = 0; + $numericminor = 0; +} +else +{ + die "$0: minor-version must be N, devel, alphaN, betaN, or rcN\n"; } # Create various required forms of the version number $majorversion = $major1 . "." . $major2; -if ($dotneeded) { - $fullversion = $majorversion . "." . $minor; -} else { - $fullversion = $majorversion . $minor; +if ($dotneeded) +{ + $fullversion = $majorversion . "." . $minor; +} +else +{ + $fullversion = $majorversion . $minor; } $numericversion = $majorversion . "." . $numericminor; $padnumericversion = sprintf("%d%02d%02d", $major1, $major2, $numericminor); @@ -63,54 +77,64 @@ $padnumericversion = sprintf("%d%02d%02d", $major1, $major2, $numericminor); $aconfver = ""; open(FILE, "configure.in") || die "could not read configure.in: $!\n"; -while () { - if (m/^m4_if\(m4_defn\(\[m4_PACKAGE_VERSION\]\), \[(.*)\], \[\], \[m4_fatal/) { - $aconfver = $1; - last; - } +while () +{ + 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 { - my($filename, $sedargs) = @_; - my($tmpfilename) = $filename . ".tmp"; +sub sed_file +{ + my ($filename, $sedargs) = @_; + my ($tmpfilename) = $filename . ".tmp"; - system("sed $sedargs $filename >$tmpfilename") == 0 - or die "sed failed: $?"; - system("mv $tmpfilename $filename") == 0 - or die "mv failed: $?"; + system("sed $sedargs $filename >$tmpfilename") == 0 + or die "sed failed: $?"; + system("mv $tmpfilename $filename") == 0 + or die "mv failed: $?"; - $fixedfiles .= "\t$filename\n"; + $fixedfiles .= "\t$filename\n"; } diff --git a/src/tools/win32tzlist.pl b/src/tools/win32tzlist.pl index c2e423f854..c5a1aaed05 100755 --- a/src/tools/win32tzlist.pl +++ b/src/tools/win32tzlist.pl @@ -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; @@ -36,21 +37,19 @@ my @system_zones; foreach my $keyname (@subkeys) { - my $subkey; - my %vals; + my $subkey; + my %vals; - $basekey->Open($keyname, $subkey) or die $!; - $subkey->GetValues(\%vals) or die $!; - $subkey->Close(); + $basekey->Open($keyname, $subkey) or die $!; + $subkey->GetValues(\%vals) or die $!; + $subkey->Close(); - die "Incomplete timezone data for $keyname!\n" - unless ($vals{Std} && $vals{Dlt} && $vals{Display}); - push @system_zones, - { - 'std'=>$vals{Std}->[2], - 'dlt'=>$vals{Dlt}->[2], - 'display'=>clean_displayname($vals{Display}->[2]), - }; + die "Incomplete timezone data for $keyname!\n" + unless ($vals{Std} && $vals{Dlt} && $vals{Display}); + push @system_zones, + { 'std' => $vals{Std}->[2], + 'dlt' => $vals{Dlt}->[2], + 'display' => clean_displayname($vals{Display}->[2]), }; } $basekey->Close(); @@ -59,7 +58,7 @@ $basekey->Close(); # Fetch all timezones currently in the file # my @file_zones; -open(TZFILE,"<$tzfile") or die "Could not open $tzfile!\n"; +open(TZFILE, "<$tzfile") or die "Could not open $tzfile!\n"; my $t = $/; undef $/; my $pgtz = ; @@ -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, - 'dlt'=>$2, - 'match'=>$3, - 'display'=>clean_displayname($4), - }; + push @file_zones, + { 'std' => $1, + 'dlt' => $2, + 'match' => $3, + 'display' => clean_displayname($4), }; } # @@ -90,47 +88,48 @@ my @add; for my $sys (@system_zones) { - my $match = 0; - for my $file (@file_zones) - { - if ($sys->{std} eq $file->{std}) - { - $match=1; - if ($sys->{dlt} ne $file->{dlt}) - { - print "Timezone $sys->{std}, changed name of daylight zone!\n"; - } - if ($sys->{display} ne $file->{display}) - { - print + my $match = 0; + for my $file (@file_zones) + { + if ($sys->{std} eq $file->{std}) + { + $match = 1; + if ($sys->{dlt} ne $file->{dlt}) + { + print + "Timezone $sys->{std}, changed name of daylight zone!\n"; + } + if ($sys->{display} ne $file->{display}) + { + print "Timezone $sys->{std} changed displayname ('$sys->{display}' from '$file->{display}')!\n"; - } - last; - } - } - unless ($match) - { - push @add, $sys; - } + } + last; + } + } + unless ($match) + { + push @add, $sys; + } } if (@add) { - print "\n\nOther than that, add the following timezones:\n"; - for my $z (@add) - { - print + print "\n\nOther than that, add the following timezones:\n"; + for my $z (@add) + { + print "\t{\n\t\t\"$z->{std}\", \"$z->{dlt}\",\n\t\t\"FIXME\"\n\t},\t\t\t\t\t\t\t/* $z->{display} */\n"; - } + } } sub clean_displayname { - my $dn = shift; + my $dn = shift; - $dn =~ s/\s+/ /gs; - $dn =~ s/\*//gs; - $dn =~ s/^\s+//gs; - $dn =~ s/\s+$//gs; - return $dn; + $dn =~ s/\s+/ /gs; + $dn =~ s/\*//gs; + $dn =~ s/^\s+//gs; + $dn =~ s/\s+$//gs; + return $dn; }