Run on HEAD and 9.2.
#!/usr/bin/perl
use strict;
+
# make sure we are in a sane environment.
use DBI();
use DBD::Pg();
my %opt;
getopts('d:b:s:veorauc', \%opt);
-if ( !( scalar %opt && defined $opt{s} ) ) {
+if (!(scalar %opt && defined $opt{s}))
+{
print <<EOT;
Usage:
$0 -d DATABASE -s SECTIONS [-b NUMBER] [-v] [-e] [-o] [-r] [-a] [-u]
}
$opt{d} ||= '_int4';
-my $dbi=DBI->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})";
}
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 )';
+}
+else
+{
+ $outf = ($opt{u}) ? 'distinct( message.mid )' : 'message.mid';
}
-my $sql = "select $outf from ".join(', ', keys %table)." where ".join(' AND ', @where).';';
+my $sql =
+ "select $outf from "
+ . join(', ', keys %table)
+ . " where "
+ . join(' AND ', @where) . ';';
-if ( $opt{v} ) {
+if ($opt{v})
+{
print "$sql\n";
}
-if ( $opt{e} ) {
+if ($opt{e})
+{
$dbi->do("explain $sql");
}
-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;
}
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 {
+ 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) );
+ @sect =
+ grep { $hash{$_}++; $hash{$_} <= 1 }
+ map { int((rand()**4) * 100) } 0 .. (int(rand() * 5));
}
- if ( $#sect < 0 || rand() < 0.1 ) {
+ if ($#sect < 0 || rand() < 0.1)
+ {
print MSG "$i\t\\N\n";
- } else {
- print MSG "$i\t{".join(',',@sect)."}\n";
+ }
+ else
+ {
+ print MSG "$i\t{" . join(',', @sect) . "}\n";
map { print MAP "$i\t$_\n" } @sect;
}
}
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(<FFF>) { print; }
+ open(FFF, "$t.tmp") || die;
+ while (<FFF>) { print; }
close FFF;
print "\\.\n";
}
$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;
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";
+ }
}
# 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";
}
use warnings;
use strict;
-print "<!-- autogenerated from src/backend/utils/errcodes.txt, do not edit -->\n";
+print
+ "<!-- autogenerated from src/backend/utils/errcodes.txt, do not edit -->\n";
open my $errcodes, $ARGV[0] or die;
-while (<$errcodes>) {
- 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 <productname/>
- s/PostgreSQL/<productname>PostgreSQL<\/>/g;
+ # Remove the Section: string
+ s/^Section: //;
- print "\n\n";
- print "<row>\n";
- print "<entry spanname=\"span12\">";
- print "<emphasis role=\"bold\">$_</></entry>\n";
- print "</row>\n";
+ # Escape dashes for SGML
+ s/-/—/;
+
+ # Wrap PostgreSQL in <productname/>
+ s/PostgreSQL/<productname>PostgreSQL<\/>/g;
- next;
- }
+ print "\n\n";
+ print "<row>\n";
+ print "<entry spanname=\"span12\">";
+ print "<emphasis role=\"bold\">$_</></entry>\n";
+ print "</row>\n";
- die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/;
+ next;
+ }
- (my $sqlstate,
- my $type,
- my $errcode_macro,
- my $condition_name) = ($1, $2, $3, $4);
+ die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/;
- # Skip lines without PL/pgSQL condition names
- next unless defined($condition_name);
+ (my $sqlstate, my $type, my $errcode_macro, my $condition_name) =
+ ($1, $2, $3, $4);
- print "\n";
- print "<row>\n";
- print "<entry><literal>$sqlstate</literal></entry>\n";
- print "<entry><symbol>$condition_name</symbol></entry>\n";
- print "</row>\n";
+ # Skip lines without PL/pgSQL condition names
+ next unless defined($condition_name);
+
+ print "\n";
+ print "<row>\n";
+ print "<entry><literal>$sqlstate</literal></entry>\n";
+ print "<entry><symbol>$condition_name</symbol></entry>\n";
+ print "</row>\n";
}
close $errcodes;
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 (<FILE>) {
- # Recursively expand sub-files of the release notes
- if (m/^&(release-.*);$/) {
- process_file($1 . ".sgml");
- next;
- }
+ while (<FILE>)
+ {
- # Remove <link ...> tags, which might span multiple lines
- while (m/<link/) {
- if (s/<link\s+linkend[^>]*>//) {
- next;
- }
- # incomplete tag, so slurp another line
- $_ .= <FILE>;
- }
+ # Recursively expand sub-files of the release notes
+ if (m/^&(release-.*);$/)
+ {
+ process_file($1 . ".sgml");
+ next;
+ }
+
+ # Remove <link ...> tags, which might span multiple lines
+ while (m/<link/)
+ {
+ if (s/<link\s+linkend[^>]*>//)
+ {
+ next;
+ }
- # Remove </link> too
- s|</link>||g;
+ # incomplete tag, so slurp another line
+ $_ .= <FILE>;
+ }
- print;
- }
- close(FILE);
+ # Remove </link> too
+ s|</link>||g;
+
+ print;
+ }
+ close(FILE);
}
my %feature_packages;
-while (<PACK>) {
- chomp;
- my ($fid, $pname) = split /\t/;
- if ($feature_packages{$fid}) {
- $feature_packages{$fid} .= ", $pname";
- } else {
- $feature_packages{$fid} = $pname;
- }
+while (<PACK>)
+{
+ chomp;
+ my ($fid, $pname) = split /\t/;
+ if ($feature_packages{$fid})
+ {
+ $feature_packages{$fid} .= ", $pname";
+ }
+ else
+ {
+ $feature_packages{$fid} = $pname;
+ }
}
close PACK;
print "<tbody>\n";
-while (<FEAT>) {
- chomp;
- my ($feature_id, $feature_name, $subfeature_id, $subfeature_name, $is_supported, $comments) = split /\t/;
-
- $is_supported eq $yesno || next;
-
- $feature_name =~ s/</</g;
- $feature_name =~ s/>/>/g;
- $subfeature_name =~ s/</</g;
- $subfeature_name =~ s/>/>/g;
-
- print " <row>\n";
-
- if ($subfeature_id) {
- print " <entry>$feature_id-$subfeature_id</entry>\n";
- } else {
- print " <entry>$feature_id</entry>\n";
- }
- print " <entry>" . $feature_packages{$feature_id} . "</entry>\n";
- if ($subfeature_id) {
- print " <entry>$subfeature_name</entry>\n";
- } else {
- print " <entry>$feature_name</entry>\n";
- }
- print " <entry>$comments</entry>\n";
-
- print " </row>\n";
+while (<FEAT>)
+{
+ chomp;
+ my ($feature_id, $feature_name, $subfeature_id,
+ $subfeature_name, $is_supported, $comments) = split /\t/;
+
+ $is_supported eq $yesno || next;
+
+ $feature_name =~ s/</</g;
+ $feature_name =~ s/>/>/g;
+ $subfeature_name =~ s/</</g;
+ $subfeature_name =~ s/>/>/g;
+
+ print " <row>\n";
+
+ if ($subfeature_id)
+ {
+ print " <entry>$feature_id-$subfeature_id</entry>\n";
+ }
+ else
+ {
+ print " <entry>$feature_id</entry>\n";
+ }
+ print " <entry>" . $feature_packages{$feature_id} . "</entry>\n";
+ if ($subfeature_id)
+ {
+ print " <entry>$subfeature_name</entry>\n";
+ }
+ else
+ {
+ print " <entry>$feature_name</entry>\n";
+ }
+ print " <entry>$comments</entry>\n";
+
+ print " </row>\n";
}
print "</tbody>\n";
# Returns a nested data structure describing the data in the headers.
sub Catalogs
{
- 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'
- );
-
- foreach my $input_file (@_)
- {
- my %catalog;
- $catalog{columns} = [];
- $catalog{data} = [];
-
- open(INPUT_FILE, '<', $input_file) || die "$input_file: $!";
-
- # Scan the input file.
- while (<INPUT_FILE>)
- {
- # Strip C-style comments.
- s;/\*(.|\n)*\*/;;g;
- if (m;/\*;)
- {
- # handle multi-line comments properly.
- my $next_line = <INPUT_FILE>;
- die "$input_file: ends within C-style comment\n"
- if !defined $next_line;
- $_ .= $next_line;
- redo;
- }
-
- # Strip useless whitespace and trailing semicolons.
- chomp;
- s/^\s+//;
- s/;\s*$//;
- s/\s+/ /g;
-
- # Push the data into the appropriate data structure.
- if (/^DATA\(insert(\s+OID\s+=\s+(\d+))?\s+\(\s*(.*)\s*\)\s*\)$/)
- {
- push @{ $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;
+ 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');
+
+ foreach my $input_file (@_)
+ {
+ my %catalog;
+ $catalog{columns} = [];
+ $catalog{data} = [];
+
+ open(INPUT_FILE, '<', $input_file) || die "$input_file: $!";
+
+ # Scan the input file.
+ while (<INPUT_FILE>)
+ {
+
+ # Strip C-style comments.
+ s;/\*(.|\n)*\*/;;g;
+ if (m;/\*;)
+ {
+
+ # handle multi-line comments properly.
+ my $next_line = <INPUT_FILE>;
+ die "$input_file: ends within C-style comment\n"
+ if !defined $next_line;
+ $_ .= $next_line;
+ redo;
+ }
+
+ # Strip useless whitespace and trailing semicolons.
+ chomp;
+ s/^\s+//;
+ s/;\s*$//;
+ s/\s+/ /g;
+
+ # Push the data into the appropriate data structure.
+ if (/^DATA\(insert(\s+OID\s+=\s+(\d+))?\s+\(\s*(.*)\s*\)\s*\)$/)
+ {
+ push @{ $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.
# 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;
# 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: $!";
# 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);
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";
-
- # open it, unless bootstrap case (create bootstrap does this automatically)
- if ($catalog->{bootstrap} eq '')
- {
- print BKI "open $catname\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;
-
- # 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;
- }
-
- # Write to postgres.bki
- my $oid = $row->{oid} ? "OID = $row->{oid} " : '';
- printf BKI "insert %s( %s)\n", $oid, $row->{bki_values};
-
- # 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};
-
- # 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';
-
- $schemapg_entries{$table_name} = [];
- push @tables_needing_macros, $table_name;
- my $is_bootstrap = $table->{bootstrap};
-
- # 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');
-
- # If it's bootstrapped, put an entry in postgres.bki.
- if ($is_bootstrap eq ' bootstrap')
- {
- bki_insert($row, @attnames);
- }
-
- # 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";
+
+ # .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";
+
+ # open it, unless bootstrap case (create bootstrap does this automatically)
+ if ($catalog->{bootstrap} eq '')
+ {
+ print BKI "open $catname\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;
+
+ # 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;
+ }
+
+ # Write to postgres.bki
+ my $oid = $row->{oid} ? "OID = $row->{oid} " : '';
+ printf BKI "insert %s( %s)\n", $oid, $row->{bki_values};
+
+ # 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};
+
+ # 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';
+
+ $schemapg_entries{$table_name} = [];
+ push @tables_needing_macros, $table_name;
+ my $is_bootstrap = $table->{bootstrap};
+
+ # 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');
+
+ # If it's bootstrapped, put an entry in postgres.bki.
+ if ($is_bootstrap eq ' bootstrap')
+ {
+ bki_insert($row, @attnames);
+ }
+
+ # 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;
}
# 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
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;
# columns were all not-null.
sub emit_pgattr_row
{
- my ($table_name, $attr, $priornotnull) = @_;
- my ($attname, $atttype) = %$attr;
- my %row;
-
- $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;
- }
-
- # 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;
- }
- }
-
- # 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};
+ my ($table_name, $attr, $priornotnull) = @_;
+ my ($attname, $atttype) = %$attr;
+ my %row;
+
+ $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;
+ }
+
+ # 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;
+ }
+ }
+
+ # 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 = @_;
-
- # 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};
-
- # 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;
+ 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|'|;
+
+ # 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;
}
# 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 (<FIND_DEFINED_SYMBOL>)
- {
- 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 (<FIND_DEFINED_SYMBOL>)
+ {
+ 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 <<EOM;
+ die <<EOM;
Usage: genbki.pl [options] header...
Options:
use warnings;
# Collect arguments
-my $infile; # pg_proc.h
+my $infile; # pg_proc.h
my $output_path = '';
while (@ARGV)
{
- my $arg = shift @ARGV;
- if ($arg !~ /^-/)
- {
- $infile = $arg;
- }
- elsif ($arg =~ /^-o/)
- {
- $output_path = length($arg) > 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.
# 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';
-
- 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;
+
+ # 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';
+
+ 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|/*-------------------------------------------------------------------------
# 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
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.
# Finally, rename the completed files into place.
Catalog::RenameTempFile($oidsfile, $tmpext);
-Catalog::RenameTempFile($tabfile, $tmpext);
+Catalog::RenameTempFile($tabfile, $tmpext);
sub usage
{
- die <<EOM;
+ die <<EOM;
Usage: perl -I [directory of Catalog.pm] Gen_fmgrtab.pl [path to pg_proc.h]
Gen_fmgrtab.pl generates fmgroids.h and fmgrtab.c from pg_proc.h
use warnings;
use strict;
-print "/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n";
+print
+ "/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n";
print "/* there is deliberately not an #ifndef ERRCODES_H here */\n";
open my $errcodes, $ARGV[0] or die;
-while (<$errcodes>) {
- 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;
#
$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( <FILE> ){
+while (<FILE>)
+{
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( <FILE> ){
+while (<FILE>)
+{
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;
}
}
#
$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( <FILE> ){
+while (<FILE>)
+{
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( <FILE> ){
+while (<FILE>)
+{
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;
}
}
$in_file = "GB2312.TXT";
-open( FILE, $in_file ) || die( "cannot open $in_file" );
+open(FILE, $in_file) || die("cannot open $in_file");
-while( <FILE> ){
+while (<FILE>)
+{
chop;
- 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;
}
}
#
reset 'array';
-open( FILE, $in_file ) || die( "cannot open $in_file" );
+open(FILE, $in_file) || die("cannot open $in_file");
-while( <FILE> ){
+while (<FILE>)
+{
chop;
- 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;
}
}
$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 = <FILE> ){
- 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 = <FILE>)
+{
+ 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" );
-
- 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;
+ 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;
$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";
}
$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;
}
$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 = <FILE> ){
- 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 = <FILE>)
+{
+ 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};
}
}
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};
}
}
#
$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( <FILE> ){
+while (<FILE>)
+{
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( <FILE> ){
+while (<FILE>)
+{
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( <FILE> ){
+while (<FILE>)
+{
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;
}
}
#
$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( <FILE> ){
+while (<FILE>)
+{
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( <FILE> ){
+while (<FILE>)
+{
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( <FILE> ){
+while (<FILE>)
+{
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;
}
}
$in_file = "KSX1001.TXT";
-open( FILE, $in_file ) || die( "cannot open $in_file" );
+open(FILE, $in_file) || die("cannot open $in_file");
-while( <FILE> ){
+while (<FILE>)
+{
chop;
- 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;
}
}
#
reset 'array';
-open( FILE, $in_file ) || die( "cannot open $in_file" );
+open(FILE, $in_file) || die("cannot open $in_file");
-while( <FILE> ){
+while (<FILE>)
+{
chop;
- 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;
}
}
$in_file = "CNS11643.TXT";
-open( FILE, $in_file ) || die( "cannot open $in_file" );
+open(FILE, $in_file) || die("cannot open $in_file");
-while( <FILE> ){
+while (<FILE>)
+{
chop;
- 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;
}
}
#
reset 'array';
-open( FILE, $in_file ) || die( "cannot open $in_file" );
+open(FILE, $in_file) || die("cannot open $in_file");
-while( <FILE> ){
+while (<FILE>)
+{
chop;
- 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;
}
}
$in_file = "ISO10646-GB18030.TXT";
-open( FILE, $in_file ) || die( "cannot open $in_file" );
+open(FILE, $in_file) || die("cannot open $in_file");
-while( <FILE> ){
+while (<FILE>)
+{
chop;
- 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);
#
#
$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;
}
}
#
reset 'array';
-open( FILE, $in_file ) || die( "cannot open $in_file" );
+open(FILE, $in_file) || die("cannot open $in_file");
-while( <FILE> ){
+while (<FILE>)
+{
chop;
- 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;
}
}
$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 = <FILE> ){
- 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 = <FILE>)
+{
+ 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};
}
}
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};
}
}
$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 = <FILE> ){
- 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 = <FILE>)
+{
+ 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};
}
}
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};
}
}
# 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( <FILE> ){
- 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 (<FILE>)
+{
+ 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;
}
}
# 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( <FILE> ){
+while (<FILE>)
+{
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;
}
}
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( <FILE> ){
+ while (<FILE>)
+ {
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;
}
}
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( <FILE> ){
+ while (<FILE>)
+ {
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;
}
}
# 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;
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, \
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;
$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.
*
";
-print CFILE
-"/*
+print CFILE "/*
* *** Do not change this file by hand. It is automatically
* *** generated from the DocBook documentation.
*
my %entries;
-foreach my $file (sort readdir DIR) {
- my (@cmdnames, $cmddesc, $cmdsynopsis);
- $file =~ /\.sgml$/ or next;
-
- open(FILE, "$docdir/$file") or next;
- my $filecontent = join('', <FILE>);
- close FILE;
-
- # Ignore files that are not for SQL language statements
- $filecontent =~ m!<refmiscinfo>\s*SQL - Language Statements\s*</refmiscinfo>!i
- or next;
-
- # Collect multiple refnames
- LOOP: { $filecontent =~ m!\G.*?<refname>\s*([a-z ]+?)\s*</refname>!cgis and push @cmdnames, $1 and redo LOOP; }
- $filecontent =~ m!<refpurpose>\s*(.+?)\s*</refpurpose>!is and $cmddesc = $1;
- $filecontent =~ m!<synopsis>\s*(.+?)\s*</synopsis>!is and $cmdsynopsis = $1;
-
- 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+)[^>]*>(.+?)</\1[^>]*>!) {
- my $match = $2;
- $match =~ s/<[^>]+>//g;
- $match =~ s/%%/%/g;
- push @params, $match;
- $cmdsynopsis =~ s!<(\w+)[^>]*>.+?</\1[^>]*>!%s!;
- }
- $cmdsynopsis =~ s/\r?\n/\\n/g;
- $cmdsynopsis =~ s/\"/\\"/g;
-
- foreach my $cmdname (@cmdnames) {
- $entries{$cmdname} = { cmddesc => $cmddesc, cmdsynopsis => $cmdsynopsis, params => \@params, nl_count => $nl_count };
- $maxlen = ($maxlen >= length $cmdname) ? $maxlen : length $cmdname;
+foreach my $file (sort readdir DIR)
+{
+ my (@cmdnames, $cmddesc, $cmdsynopsis);
+ $file =~ /\.sgml$/ or next;
+
+ open(FILE, "$docdir/$file") or next;
+ my $filecontent = join('', <FILE>);
+ close FILE;
+
+ # Ignore files that are not for SQL language statements
+ $filecontent =~
+ m!<refmiscinfo>\s*SQL - Language Statements\s*</refmiscinfo>!i
+ or next;
+
+ # Collect multiple refnames
+ LOOP:
+ {
+ $filecontent =~ m!\G.*?<refname>\s*([a-z ]+?)\s*</refname>!cgis
+ and push @cmdnames, $1
+ and redo LOOP;
+ }
+ $filecontent =~ m!<refpurpose>\s*(.+?)\s*</refpurpose>!is
+ and $cmddesc = $1;
+ $filecontent =~ m!<synopsis>\s*(.+?)\s*</synopsis>!is
+ and $cmdsynopsis = $1;
+
+ 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+)[^>]*>(.+?)</\1[^>]*>!)
+ {
+ my $match = $2;
+ $match =~ s/<[^>]+>//g;
+ $match =~ s/%%/%/g;
+ push @params, $match;
+ $cmdsynopsis =~ s!<(\w+)[^>]*>.+?</\1[^>]*>!%s!;
+ }
+ $cmdsynopsis =~ s/\r?\n/\\n/g;
+ $cmdsynopsis =~ s/\"/\\"/g;
+
+ foreach my $cmdname (@cmdnames)
+ {
+ $entries{$cmdname} = {
+ cmddesc => $cmddesc,
+ cmdsynopsis => $cmdsynopsis,
+ params => \@params,
+ nl_count => $nl_count };
+ $maxlen =
+ ($maxlen >= length $cmdname) ? $maxlen : length $cmdname;
+ }
+ }
+ else
+ {
+ die "$0: parsing file '$file' failed (N='@cmdnames' D='$cmddesc')\n";
}
- }
- else {
- die "$0: parsing file '$file' failed (N='@cmdnames' D='$cmddesc')\n";
- }
}
-foreach (sort keys %entries) {
- 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) . ");
}
";
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} },
};
-#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) */
# Copyright (c) 2009-2012, PostgreSQL Global Development Group
#
# Written by Michael Meskes <meskes@postgresql.org>
-# Andy Colson <andy@squeakycode.net>
+# Andy Colson <andy@squeakycode.net>
#
# Placed under the same license as PostgreSQL.
#
{
$verbose = shift;
}
-my $path = shift || '.';
+my $path = shift || '.';
my $parser = shift || '../../../backend/parser/gram.y';
my $filename = $path . "/ecpg.addons";
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 (<GRAM>)
+while (<GRAM>)
{
- if (/^%%/)
+ if (/^%%/)
{
$yaccmode++;
}
- if ( $yaccmode != 1 )
+ if ($yaccmode != 1)
{
next;
}
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;
$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];
}
$cc = 0;
open ECPG, $filename or die $!;
-while (<ECPG>)
+while (<ECPG>)
{
- 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;
#
# Written by Mike Aubury <mike.aubury@aubit.com>
# Michael Meskes <meskes@postgresql.org>
-# Andy Colson <andy@squeakycode.net>
+# Andy Colson <andy@squeakycode.net>
#
# Placed under the same license as PostgreSQL.
#
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
'FCONST' => 'ecpg_fconst',
'Sconst' => 'ecpg_sconst',
'IDENT' => 'ecpg_ident',
- 'PARAM' => 'ecpg_param',
-);
+ 'PARAM' => 'ecpg_param',);
# or in the block
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
'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.
'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();
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 '');
-
- # 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 (/^%%/) {
+ chomp;
+
+ # comment out the line below to make the result file match (blank line wise)
+ # the prior version.
+ #next if ($_ eq '');
+
+ # 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;
# 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 = '| ';
}
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} = '<str>';
$copymode = 1;
}
- elsif ( $replace_types{$non_term_id} eq 'ignore' )
+ elsif ($replace_types{$non_term_id} eq 'ignore')
{
$copymode = 0;
$line = '';
# 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;
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));
}
}
}
# 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, '');
}
# 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;
$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++;
# 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;
}
}
=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+)?/)
{
{
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;
# 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;
-sub plperl_die {
- (my $msg = shift) =~ s/\(eval \d+\) //g;
- die $msg;
-}
-$SIG{__DIE__} = \&plperl_die;
+ package PostgreSQL::InServer;
+ use strict;
+ use warnings;
-sub mkfuncsrc {
- my ($name, $imports, $prolog, $src) = @_;
+ sub plperl_warn
+ {
+ (my $msg = shift) =~ s/\(eval \d+\) //g;
+ chomp $msg;
+ &::elog(&::WARNING, $msg);
+ }
+ $SIG{__WARN__} = \&plperl_warn;
- my $BEGIN = join "\n", map {
- my $names = $imports->{$_} || [];
- "$_->import(qw(@$names));"
- } sort keys %$imports;
- $BEGIN &&= "BEGIN { $BEGIN }";
+ sub plperl_die
+ {
+ (my $msg = shift) =~ s/\(eval \d+\) //g;
+ die $msg;
+ }
+ $SIG{__DIE__} = \&plperl_die;
- return qq[ package main; sub { $BEGIN $prolog $src } ];
-}
+ sub mkfuncsrc
+ {
+ my ($name, $imports, $prolog, $src) = @_;
-sub mkfunc {
- no strict; # default to no strict for the eval
- no warnings; # default to no warnings for the eval
- my $ret = eval(mkfuncsrc(@_));
- $@ =~ s/\(eval \d+\) //g if $@;
- return $ret;
-}
+ my $BEGIN = join "\n", map {
+ my $names = $imports->{$_} || [];
+ "$_->import(qw(@$names));"
+ } sort keys %$imports;
+ $BEGIN &&= "BEGIN { $BEGIN }";
-1;
+ return qq[ package main; sub { $BEGIN $prolog $src } ];
+ }
+
+ sub mkfunc
+ {
+ no strict; # default to no strict for the eval
+ no warnings; # default to no warnings for the eval
+ my $ret = eval(mkfuncsrc(@_));
+ $@ =~ s/\(eval \d+\) //g if $@;
+ return $ret;
+ }
+
+ 1;
}
{
-package PostgreSQL::InServer::ARRAY;
-use strict;
-use warnings;
-use overload
- '""'=>\&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'});
-}
+ use overload
+ '""' => \&to_str,
+ '@{}' => \&to_arr;
-sub to_arr {
- return shift->{'array'};
-}
+ sub to_str
+ {
+ my $self = shift;
+ return ::encode_typed_literal($self->{'array'}, $self->{'typeoid'});
+ }
+
+ sub to_arr
+ {
+ return shift->{'array'};
+ }
-1;
+ 1;
}
use Opcode qw(opset opset_to_ops opdesc);
-my $plperl_opmask_h = shift
- or die "Usage: $0 <output_filename.h>\n";
+my $plperl_opmask_h = shift
+ or die "Usage: $0 <output_filename.h>\n";
-my $plperl_opmask_tmp = $plperl_opmask_h."tmp";
+my $plperl_opmask_tmp = $plperl_opmask_h . "tmp";
END { unlink $plperl_opmask_tmp }
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;
'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{
/*
*/
};
-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;
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;
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;
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;
use locale;
open(INFILE, "<$ARGV[0]");
-chop(my(@words) = <INFILE>);
+chop(my (@words) = <INFILE>);
close(INFILE);
-$"="\n";
-my(@result) = sort @words;
+$" = "\n";
+my (@result) = sort @words;
print "@result\n";
# 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
# an idea of what can be done for features unsupported by an DBMS.)
#
@perftests = (
-# It speed up things
-'connection.ntm', 'DB connection startup (no timing)',
-# Just connection startup time (echo "" | psql ... - for PgSQL)
-'connection', 'DB connection startup',
-'crtsimple.ntm', 'Create SIMPLE table (no timing)',
-# 8192 inserts in single xaction
-'inssimple T', '8192 INSERTs INTO SIMPLE (1 xact)',
-'drpsimple.ntm', 'Drop SIMPLE table (no timing)',
-'crtsimple.ntm', 'Create SIMPLE table (no timing)',
-# 8192 inserts in 8192 xactions
-'inssimple', '8192 INSERTs INTO SIMPLE (8192 xacts)',
-'vacuum.ntm', 'Vacuum (no timing)',
-# Fast (after table filled with data) index creation test
-'crtsimpleidx', 'Create INDEX on SIMPLE',
-'drpsimple.ntm', 'Drop SIMPLE table (no timing)',
-'crtsimple.ntm', 'Create SIMPLE table (no timing)',
-'crtsimpleidx.ntm', 'Create INDEX on SIMPLE (no timing)',
-# 8192 inserts in single xaction into table with index
-'inssimple T', '8192 INSERTs INTO SIMPLE with INDEX (1 xact)',
-# 8192 SELECT * FROM simple WHERE justint = <random_key> in single xaction
-'slcsimple T', '8192 random INDEX scans on SIMPLE (1 xact)',
-# SELECT * FROM simple ORDER BY justint
-'orbsimple', 'ORDER BY SIMPLE',
-);
+
+ # It speed up things
+ 'connection.ntm', 'DB connection startup (no timing)',
+
+ # Just connection startup time (echo "" | psql ... - for PgSQL)
+ 'connection', 'DB connection startup',
+ 'crtsimple.ntm', 'Create SIMPLE table (no timing)',
+
+ # 8192 inserts in single xaction
+ 'inssimple T', '8192 INSERTs INTO SIMPLE (1 xact)',
+ 'drpsimple.ntm', 'Drop SIMPLE table (no timing)',
+ 'crtsimple.ntm', 'Create SIMPLE table (no timing)',
+
+ # 8192 inserts in 8192 xactions
+ 'inssimple', '8192 INSERTs INTO SIMPLE (8192 xacts)',
+ 'vacuum.ntm', 'Vacuum (no timing)',
+
+ # Fast (after table filled with data) index creation test
+ 'crtsimpleidx', 'Create INDEX on SIMPLE',
+ 'drpsimple.ntm', 'Drop SIMPLE table (no timing)',
+ 'crtsimple.ntm', 'Create SIMPLE table (no timing)',
+ 'crtsimpleidx.ntm', 'Create INDEX on SIMPLE (no timing)',
+
+ # 8192 inserts in single xaction into table with index
+ 'inssimple T', '8192 INSERTs INTO SIMPLE with INDEX (1 xact)',
+
+ # 8192 SELECT * FROM simple WHERE justint = <random_key> in single xaction
+ 'slcsimple T', '8192 random INDEX scans on SIMPLE (1 xact)',
+
+ # SELECT * FROM simple ORDER BY justint
+ 'orbsimple', 'ORDER BY SIMPLE',);
#
# It seems that nothing below need to be changed
$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 (<TMPF>)
{
$str = $_;
- ($test, $rtime) = split (/:/, $str);
- ($tmp, $rtime, $rest) = split (/[ ]+/, $rtime);
+ ($test, $rtime) = split(/:/, $str);
+ ($tmp, $rtime, $rest) = split(/[ ]+/, $rtime);
print RESF "$test: $rtime\n";
}
# 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+(.*)$/)
+ {
+
+ # first rule for nonterminal
+ $rule_number = $1;
+ $cur_nonterminal = $2;
+ $rhs = $3;
+ }
+ elsif (m/^\s*(\d+)\s+\|\s+(.*)$/)
+ {
+
+ # additional rule for nonterminal
+ $rule_number = $1;
+ $rhs = $2;
+ }
+ }
+
+ # Process rule if we found one
+ if (defined $rule_number)
+ {
+
+ # deconstruct the RHS
+ $rhs =~ s|^/\* empty \*/$||;
+ my @rhs = split '\s', $rhs;
+ print "Rule $rule_number: $cur_nonterminal := @rhs\n" if $debug;
- # Process rule if we found one
- 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";
+ # 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;
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");
my @arr;
my %keywords;
-line: while (<GRAM>) {
- chomp; # strip record separator
-
- $S = $_;
- # Make sure any braces are split
- $s = '{', $S =~ s/$s/ { /g;
- $s = '}', $S =~ s/$s/ } /g;
- # Any comments are split
- $s = '[/][*]', $S =~ s#$s# /* #g;
- $s = '[*][/]', $S =~ s#$s# */ #g;
-
- if (!($kcat)) {
- # Is this the beginning of a keyword list?
- foreach $k (keys %keyword_categories) {
- if ($S =~ m/^($k):/) {
- $kcat = $k;
- next line;
- }
- }
- next line;
- }
+line: while (<GRAM>)
+{
+ chomp; # strip record separator
- # Now split the line into individual fields
- $n = (@arr = split(' ', $S));
+ $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;
- }
+ # Make sure any braces are split
+ $s = '{', $S =~ s/$s/ { /g;
+ $s = '}', $S =~ s/$s/ } /g;
- if ($arr[$fieldIndexer] eq ';') {
- # end of keyword list
- $kcat = '';
- next;
- }
+ # Any comments are split
+ $s = '[/][*]', $S =~ s#$s# /* #g;
+ $s = '[*][/]', $S =~ s#$s# */ #g;
- if ($arr[$fieldIndexer] eq '|') {
- next;
+ 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;
}
- # Put this keyword into the right list
- push @{$keywords{$kcat}}, $arr[$fieldIndexer];
- }
+ # 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;
+ }
+
+ 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 $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 $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;
+ }
+ $prevkword = $bare_kword;
}
- $prevkword = $bare_kword;
- }
}
# Transform the keyword lists into hashes.
# 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
my $prevkwstring = '';
my $bare_kwname;
my %kwhash;
-kwlist_line: while (<KWLIST>) {
- my($line) = $_;
-
- 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";
- }
- $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";
+kwlist_line: while (<KWLIST>)
+{
+ my ($line) = $_;
+
+ 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";
+ }
+ $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};
+ }
+ }
}
-
- # 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;
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
+{
-sub wanted {
- # prevent corruption of git indexes by ignoring any .git/
- if ($_ eq '.git')
- {
- $File::Find::prune = 1;
- return;
- }
+ # 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)$);
+ 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";
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)
unlink $target || confess "Could not delete $target\n";
}
- copy($src,$target)
+ copy($src, $target)
|| confess "Could not copy $src to $target\n";
}
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")
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";
}
sub CopyFiles
{
- my $what = shift;
- my $target = shift;
+ my $what = shift;
+ my $target = shift;
my $basedir = shift;
print "Copying $what";
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";
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';
}
$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)
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{<ConfigurationType>(\w+)</ConfigurationType>})
{
if ($1 eq 'Application')
$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;
}
}
{
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 ".";
}
sub GenerateConversionScript
{
my $target = shift;
- my $sql = "";
+ my $sql = "";
my $F;
print "Generating conversion proc script...";
$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";
"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);
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));
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")
{
{
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");
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))
}
$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))
}
$flist = '';
- if ($mf =~ /^DOCS\s*=\s*(.*)$/mg) {$flist .= $1}
+ if ($mf =~ /^DOCS\s*=\s*(.*)$/mg) { $flist .= $1 }
if ($flist ne '')
{
$flist = ParseAndCleanRule($flist, $mf);
$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)
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;
}
{
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;
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($_);
"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 ".";
}
}
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;
sub _new
{
my $classname = shift;
- my $self = $classname->SUPER::_new(@_);
+ my $self = $classname->SUPER::_new(@_);
bless($self, $classname);
$self->{filenameExtension} = '.vcxproj';
</PropertyGroup>
<Import Project="\$(VCTargetsPath)\\Microsoft.Cpp.Default.props" />
EOF
- $self->WriteConfigurationPropertyGroup($f, 'Release',{wholeopt=>'false'});
- $self->WriteConfigurationPropertyGroup($f, 'Debug',{wholeopt=>'false'});
+ $self->WriteConfigurationPropertyGroup($f, 'Release',
+ { wholeopt => 'false' });
+ $self->WriteConfigurationPropertyGroup($f, 'Debug',
+ { wholeopt => 'false' });
print $f <<EOF;
<Import Project="\$(VCTargetsPath)\\Microsoft.Cpp.props" />
<ImportGroup Label="ExtensionSettings">
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
{
my ($self, $f) = @_;
- my @references = @{$self->{references}};
+ my @references = @{ $self->{references} };
if (scalar(@references))
{
print $f <<EOF;
<ItemGroup>
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$/)
{
</CustomBuild>
EOF
}
- else #if ($grammarFile =~ /\.l$/)
+ else #if ($grammarFile =~ /\.l$/)
{
print $f <<EOF;
<CustomBuild Include="$grammarFile">
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 <<EOF;
<PropertyGroup Condition="'\$(Configuration)|\$(Platform)'=='$cfgname|$self->{platform}'" Label="Configuration">
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 =~ /;$/)
sub new
{
my $classname = shift;
- my $self = $classname->SUPER::_new(@_);
+ my $self = $classname->SUPER::_new(@_);
bless($self, $classname);
$self->{vcver} = '10.00';
use Exporter;
our (@ISA, @EXPORT_OK);
-@ISA = qw(Exporter);
+@ISA = qw(Exporter);
@EXPORT_OK = qw(Mkvcbuild);
my $solution;
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();
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');
$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}
. ">$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]);
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);
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');
$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');
$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');
$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');
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');
# 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');
$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})
$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})
}
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');
{
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/;
$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$/)
$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');
# 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)
# 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)
{
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
{
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)
{
sub GenerateContribSqlFiles
{
- my $n = shift;
+ my $n = shift;
my $mf = shift;
if ($mf =~ /^DATA_built\s*=\s*(.*)$/mg)
{
{
$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);
sub AdjustContribProj
{
my $proj = shift;
- my $n = $proj->{name};
+ my $n = $proj->{name};
if ($contrib_defines->{$n})
{
$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} });
}
}
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,
solution => $solution,
disablewarnings => '4018;4244;4273;4102;4090;4267',
disablelinkerwarnings => '',
- platform => $solution->{platform},
- };
+ platform => $solution->{platform}, };
bless($self, $classname);
return $self;
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;
}
}
my ($self, $filename, $newname) = @_;
my $re = "\\\\$filename\$";
- foreach my $file (keys %{$self->{files}})
+ foreach my $file (keys %{ $self->{files} })
{
# Match complete filename
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;
}
sub RelocateFiles
{
my ($self, $targetdir, $proc) = @_;
- foreach my $f (keys %{$self->{files}})
+ foreach my $f (keys %{ $self->{files} })
{
my $r = &$proc($f);
if ($r)
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");
}
}
$lib = '"' . $lib . """;
}
- push @{$self->{libraries}}, $lib;
+ push @{ $self->{libraries} }, $lib;
if ($dbgsuffix)
{
- push @{$self->{suffixlib}}, $lib;
+ push @{ $self->{suffixlib} }, $lib;
}
}
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
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);
$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";
}
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;
}
$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\)\/(.*)/)
# 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)")
my $desc = $1;
my $ico;
if ($mf =~ /^PGAPPICON\s*=\s*(.*)$/m) { $ico = $1; }
- $self->AddResourceFile($reldir,$desc,$ico);
+ $self->AddResourceFile($reldir, $desc, $ico);
}
$/ = $t;
}
{
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 (<I>)
{
s/FILEDESC/"$desc"/gm;
{
my ($self, $warnings) = @_;
- $self->{disablelinkerwarnings} .= ',' unless ($self->{disablelinkerwarnings} eq '');
+ $self->{disablelinkerwarnings} .= ','
+ unless ($self->{disablelinkerwarnings} eq '');
$self->{disablelinkerwarnings} .= $warnings;
}
{
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);
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)
{
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
}
}
$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();
# 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 (<P>)
{
if (/^\/favor:</)
sub IsNewer
{
my ($newfile, $oldfile) = @_;
- if ( $oldfile ne 'src\tools\msvc\config.pl'
+ if ( $oldfile ne 'src\tools\msvc\config.pl'
&& $oldfile ne 'src\tools\msvc\config_default.pl')
{
return 1
sub copyFile
{
my ($src, $dest) = @_;
- open(I,$src) || croak "Could not open $src";
- open(O,">$dest") || croak "Could not open $dest";
+ open(I, $src) || croak "Could not open $src";
+ open(O, ">$dest") || croak "Could not open $dest";
while (<I>)
{
print O;
my $bits = $self->{platform} eq 'Win32' ? 32 : 64;
# Parse configure.in to get version numbers
- open(C,"configure.in") || confess("Could not open configure.in for reading\n");
+ open(C, "configure.in")
+ || confess("Could not open configure.in for reading\n");
while (<C>)
{
if (/^AC_INIT\(\[PostgreSQL\], \[([^\]]+)\]/)
{
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);
}
}
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 (<I>)
{
s{PG_VERSION "[^"]+"}{PG_VERSION "$self->{strver}"};
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})
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(
}
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(
);
}
- 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(
);
}
- 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(
);
}
- 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 (<I>)
{
s/(VERSION.*),0/$1,$d/;
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');
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');
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 <<EOF;
#if (_MSC_VER > 1200)
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 <<EOF;
+ print O <<EOF;
#define PGBINDIR "/bin"
#define PGSHAREDIR "/share"
#define SYSCONFDIR "/etc"
foreach my $bki (@allbki)
{
next if $bki eq "";
- if (IsNewer('src/backend/catalog/postgres.bki', "src/include/catalog/$bki"))
+ if (IsNewer(
+ 'src/backend/catalog/postgres.bki',
+ "src/include/catalog/$bki"))
{
print "Generating postgres.bki and schemapg.h...\n";
chdir('src\backend\catalog');
"perl genbki.pl -I../../../src/include/catalog --set-version=$self->{majorver} $bki_srcs"
);
chdir('..\..\..');
- copyFile('src\backend\catalog\schemapg.h',
+ copyFile(
+ 'src\backend\catalog\schemapg.h',
'src\include\catalog\schemapg.h');
last;
}
}
- open(O, ">doc/src/sgml/version.sgml") || croak "Could not write to version.sgml\n";
+ open(O, ">doc/src/sgml/version.sgml")
+ || croak "Could not write to version.sgml\n";
print O <<EOF;
<!ENTITY version "$self->{strver}">
<!ENTITY majorversion "$self->{majorver}">
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 (<I>)
{
{
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})
{
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})
{
{
$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})
{
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 <<EOF;
Microsoft Visual Studio Solution File, Format Version $self->{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 <<EOF;
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "$proj->{name}", "$proj->{name}$proj->{filenameExtension}", "$proj->{guid}"
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 <<EOF;
$proj->{guid}.Debug|$self->{platform}.ActiveCfg = Debug|$self->{platform}
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";
}
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;
}
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;
}
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;
}
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;
}
sub _new
{
my $classname = shift;
- my $self = $classname->SUPER::_new(@_);
+ my $self = $classname->SUPER::_new(@_);
bless($self, $classname);
$self->{filenameExtension} = '.vcproj';
<Platforms><Platform Name="$self->{platform}"/></Platforms>
<Configurations>
EOF
- $self->WriteConfiguration($f, 'Debug',
- {defs=>'_DEBUG;DEBUG=1;', wholeopt=>0, opt=>0, strpool=>'false', runtime=>3});
- $self->WriteConfiguration($f, 'Release',
- {defs=>'', wholeopt=>0, opt=>3, strpool=>'true', runtime=>2});
+ $self->WriteConfiguration(
+ $f, 'Debug',
+ { defs => '_DEBUG;DEBUG=1;',
+ wholeopt => 0,
+ opt => 0,
+ strpool => 'false',
+ runtime => 3 });
+ $self->WriteConfiguration(
+ $f,
+ 'Release',
+ { defs => '',
+ wholeopt => 0,
+ opt => 3,
+ strpool => 'true',
+ runtime => 2 });
print $f <<EOF;
</Configurations>
EOF
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 . " </Filter>\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 . " <Filter Name=\"$pieces[0]\" Filter=\"\">\n";
+ print $f ' ' x $#dirstack
+ . " <Filter Name=\"$pieces[0]\" Filter=\"\">\n";
}
- print $f ' ' x $#dirstack . " <File RelativePath=\"$fileNameWithPath\"";
+ print $f ' ' x $#dirstack
+ . " <File RelativePath=\"$fileNameWithPath\"";
if ($fileNameWithPath =~ /\.y$/)
{
my $of = $fileNameWithPath;
$of =~ s/\.y$/.c/;
- $of =~ s{^src\\pl\\plpgsql\\src\\gram.c$}{src\\pl\\plpgsql\\src\\pl_gram.c};
+ $of =~
+s{^src\\pl\\plpgsql\\src\\gram.c$}{src\\pl\\plpgsql\\src\\pl_gram.c};
print $f '>'
- . $self->GenerateCustomTool('Running bison on ' . $fileNameWithPath,
+ . $self->GenerateCustomTool(
+ 'Running bison on ' . $fileNameWithPath,
"perl src\\tools\\msvc\\pgbison.pl $fileNameWithPath", $of)
. '</File>' . "\n";
}
my $of = $fileNameWithPath;
$of =~ s/\.l$/.c/;
print $f '>'
- . $self->GenerateCustomTool('Running flex on ' . $fileNameWithPath,
+ . $self->GenerateCustomTool(
+ 'Running flex on ' . $fileNameWithPath,
"perl src\\tools\\msvc\\pgflex.pl $fileNameWithPath", $of)
. '</File>' . "\n";
}
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;
EOF
if ($self->{disablelinkerwarnings})
{
- print $f "\t\tAdditionalOptions=\"/ignore:$self->{disablelinkerwarnings}\"\n";
+ print $f
+"\t\tAdditionalOptions=\"/ignore:$self->{disablelinkerwarnings}\"\n";
}
if ($self->{implib})
{
{
my ($self, $f) = @_;
print $f " <References>\n";
- foreach my $ref (@{$self->{references}})
+ foreach my $ref (@{ $self->{references} })
{
print $f
" <ProjectReference ReferencedProjectIdentifier=\"$ref->{guid}\" Name=\"$ref->{name}\" />\n";
if (!defined($cfg))
{
return $self->GenerateCustomTool($desc, $tool, $output, 'Debug')
- .$self->GenerateCustomTool($desc, $tool, $output, 'Release');
+ . $self->GenerateCustomTool($desc, $tool, $output, 'Release');
}
return
"<FileConfiguration Name=\"$cfg|$self->{platform}\"><Tool Name=\"VCCustomBuildTool\" Description=\"$desc\" CommandLine=\"$tool\" AdditionalDependencies=\"\" Outputs=\"$output\" /></FileConfiguration>";
sub new
{
my $classname = shift;
- my $self = $classname->SUPER::_new(@_);
+ my $self = $classname->SUPER::_new(@_);
bless($self, $classname);
$self->{vcver} = '8.00';
sub new
{
my $classname = shift;
- my $self = $classname->SUPER::_new(@_);
+ my $self = $classname->SUPER::_new(@_);
bless($self, $classname);
$self->{vcver} = '9.00';
use MSBuildProject;
our (@ISA, @EXPORT);
-@ISA = qw(Exporter);
+@ISA = qw(Exporter);
@EXPORT = qw(CreateSolution CreateProject DetermineVisualStudioVersion);
sub CreateSolution
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(<P>)
+"Unable to determine Visual Studio version: The nmake command wasn't found.";
{
chomp;
if (/(\d+)\.(\d+)\.\d+(\.\d+)?$/)
}
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
BEGIN
{
- chdir("../../..") if (-d "../msvc" && -d "../../../src");
+ chdir("../../..") if (-d "../msvc" && -d "../../../src");
}
# 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";
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)
{
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');
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;
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;
# 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";
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;
}
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=<path>
- tcl
=>undef, # --with-tls=<path>
- perl=>undef, # --with-perl
- python
=>undef, # --with-python=<path>
- krb5
=>undef, # --with-krb5=<path>
- openssl
=>undef, # --with-ssl=<path>
- uuid=>undef, # --with-ossp-uuid
- xml
=>undef, # --with-libxml=<path>
- xslt
=>undef, # --with-libxslt=<path>
- iconv=>undef, # (not in configure, path to iconv)
- zlib
=>undef # --with-zlib=<path>
+ 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=<path>
+ tcl
=> undef, # --with-tls=<path>
+ perl => undef, # --with-perl
+ python
=> undef, # --with-python=<path>
+ krb5
=> undef, # --with-krb5=<path>
+ openssl
=> undef, # --with-ssl=<path>
+ uuid => undef, # --with-ossp-uuid
+ xml
=> undef, # --with-libxml=<path>
+ xslt
=> undef, # --with-libxslt=<path>
+ iconv => undef, # (not in configure, path to iconv)
+ zlib
=> undef # --with-zlib=<path>
};
1;
#
die "Usage: gendef.pl <modulepath> <platform>\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")
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, "<symbols.out") || die "Could not open symbols.out for $_\n";
while (<F>)
{
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?
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';
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')
{
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' : '');
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";
# 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 : '');
# 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/;
}
my $what = shift || "";
-if ($what =~ /^(check|installcheck|plcheck|contribcheck|ecpgcheck|isolationcheck)$/i)
+if ($what =~
+ /^(check|installcheck|plcheck|contribcheck|ecpgcheck|isolationcheck)$/i)
{
$what = uc $what;
}
# 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}";
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};
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;
}
{
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",
"--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;
}
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;
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;
sub fetchRegressOpts
{
my $handle;
- open($handle,"<GNUmakefile")
- || open($handle,"<Makefile")
+ open($handle, "<GNUmakefile")
+ || open($handle, "<Makefile")
|| die "Could not open Makefile";
- local($/) = undef;
+ local ($/) = undef;
my $m = <$handle>;
close($handle);
my @opts;
# 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)
{
{
my $handle;
- open($handle,"<GNUmakefile")
- || open($handle,"<Makefile")
+ open($handle, "<GNUmakefile")
+ || open($handle, "<Makefile")
|| die "Could not open Makefile";
- local($/) = undef;
+ local ($/) = undef;
my $m = <$handle>;
close($handle);
my $t = "";
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;
$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);
$aconfver = "";
open(FILE, "configure.in") || die "could not read configure.in: $!\n";
-while (<FILE>) {
- if (m/^m4_if\(m4_defn\(\[m4_PACKAGE_VERSION\]\), \[(.*)\], \[\], \[m4_fatal/) {
- $aconfver = $1;
- last;
- }
+while (<FILE>)
+{
+ if (
+m/^m4_if\(m4_defn\(\[m4_PACKAGE_VERSION\]\), \[(.*)\], \[\], \[m4_fatal/)
+ {
+ $aconfver = $1;
+ last;
+ }
}
close(FILE);
-$aconfver ne "" || die "could not find autoconf version number in configure.in\n";
+$aconfver ne ""
+ || die "could not find autoconf version number in configure.in\n";
# Update configure.in and other files that contain version numbers
$fixedfiles = "";
sed_file("configure.in",
- "-e 's/AC_INIT(\\[PostgreSQL\\], \\[[0-9a-z.]*\\]/AC_INIT([PostgreSQL], [$fullversion]/'");
+"-e 's/AC_INIT(\\[PostgreSQL\\], \\[[0-9a-z.]*\\]/AC_INIT([PostgreSQL], [$fullversion]/'"
+);
sed_file("doc/bug.template",
- "-e 's/PostgreSQL version (example: PostgreSQL .*) *: PostgreSQL .*/PostgreSQL version (example: PostgreSQL $fullversion): PostgreSQL $fullversion/'");
+"-e 's/PostgreSQL version (example: PostgreSQL .*) *: PostgreSQL .*/PostgreSQL version (example: PostgreSQL $fullversion): PostgreSQL $fullversion/'"
+);
sed_file("src/include/pg_config.h.win32",
- "-e 's/#define PACKAGE_STRING \"PostgreSQL .*\"/#define PACKAGE_STRING \"PostgreSQL $fullversion\"/' " .
- "-e 's/#define PACKAGE_VERSION \".*\"/#define PACKAGE_VERSION \"$fullversion\"/' " .
- "-e 's/#define PG_VERSION \".*\"/#define PG_VERSION \"$fullversion\"/' " .
- "-e 's/#define PG_VERSION_NUM .*/#define PG_VERSION_NUM $padnumericversion/'");
+"-e 's/#define PACKAGE_STRING \"PostgreSQL .*\"/#define PACKAGE_STRING \"PostgreSQL $fullversion\"/' "
+ . "-e 's/#define PACKAGE_VERSION \".*\"/#define PACKAGE_VERSION \"$fullversion\"/' "
+ . "-e 's/#define PG_VERSION \".*\"/#define PG_VERSION \"$fullversion\"/' "
+ . "-e 's/#define PG_VERSION_NUM .*/#define PG_VERSION_NUM $padnumericversion/'"
+);
sed_file("src/interfaces/libpq/libpq.rc.in",
- "-e 's/FILEVERSION [0-9]*,[0-9]*,[0-9]*,0/FILEVERSION $major1,$major2,$numericminor,0/' " .
- "-e 's/PRODUCTVERSION [0-9]*,[0-9]*,[0-9]*,0/PRODUCTVERSION $major1,$major2,$numericminor,0/' " .
- "-e 's/VALUE \"FileVersion\", \"[0-9.]*/VALUE \"FileVersion\", \"$numericversion/' " .
- "-e 's/VALUE \"ProductVersion\", \"[0-9.]*/VALUE \"ProductVersion\", \"$numericversion/'");
+"-e 's/FILEVERSION [0-9]*,[0-9]*,[0-9]*,0/FILEVERSION $major1,$major2,$numericminor,0/' "
+ . "-e 's/PRODUCTVERSION [0-9]*,[0-9]*,[0-9]*,0/PRODUCTVERSION $major1,$major2,$numericminor,0/' "
+ . "-e 's/VALUE \"FileVersion\", \"[0-9.]*/VALUE \"FileVersion\", \"$numericversion/' "
+ . "-e 's/VALUE \"ProductVersion\", \"[0-9.]*/VALUE \"ProductVersion\", \"$numericversion/'"
+);
sed_file("src/port/win32ver.rc",
- "-e 's/FILEVERSION [0-9]*,[0-9]*,[0-9]*,0/FILEVERSION $major1,$major2,$numericminor,0/' " .
- "-e 's/PRODUCTVERSION [0-9]*,[0-9]*,[0-9]*,0/PRODUCTVERSION $major1,$major2,$numericminor,0/'");
+"-e 's/FILEVERSION [0-9]*,[0-9]*,[0-9]*,0/FILEVERSION $major1,$major2,$numericminor,0/' "
+ . "-e 's/PRODUCTVERSION [0-9]*,[0-9]*,[0-9]*,0/PRODUCTVERSION $major1,$major2,$numericminor,0/'"
+);
print "Stamped these files with version number $fullversion:\n$fixedfiles";
print "Don't forget to run autoconf $aconfver before committing.\n";
exit 0;
-sub sed_file {
- 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";
}
# 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;
foreach my $keyname (@subkeys)
{
- my $subkey;
- my %vals;
-
- $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]),
- };
+ my $subkey;
+ my %vals;
+
+ $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]), };
}
$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 = <TZFILE>;
$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), };
}
#
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;
}
projects / postgresql / commitdiff