Skip to content

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

Run newly-configured perltidy script on Perl files. 

Run on HEAD and 9.2.
parent d7c73484
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 3297 additions and 2637 deletions
contrib/intarray/bench/bench.pl
View file @ 042d9ffc
#!/usr/bin/perl
use strict;
# make sure we are in a sane environment.
use DBI();
use DBD::Pg();
......@@ -10,7 +11,8 @@ use Getopt::Std;
my %opt;
getopts('d:b:s:veorauc', \%opt);
if ( !( scalar %opt && defined $opt{s} ) ) {
if (!(scalar %opt && defined $opt{s}))
{
print <<EOT;
Usage:
$0 -d DATABASE -s SECTIONS [-b NUMBER] [-v] [-e] [-o] [-r] [-a] [-u]
......@@ -30,27 +32,37 @@ EOT
}
$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})";
......@@ -58,48 +70,66 @@ if ( $opt{a} ) {
}
my $outf;
if ( $opt{c} ) {
$outf = ( $opt{u} ) ? 'count( distinct message.mid )' : 'count( message.mid )';
} else {
$outf = ( $opt{u} ) ? 'distinct( message.mid )' : 'message.mid';
if ($opt{c})
{
$outf =
($opt{u}) ? 'count( distinct message.mid )' : 'count( message.mid )';
}
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;
}
contrib/intarray/bench/create_test.pl
View file @ 042d9ffc
......@@ -15,28 +15,38 @@ create table message_section_map (
EOT
open(MSG,">message.tmp") || die;
open(MAP,">message_section_map.tmp") || die;
open(MSG, ">message.tmp") || die;
open(MAP, ">message_section_map.tmp") || die;
srand(1);
srand( 1 );
#foreach my $i ( 1..1778 ) {
#foreach my $i ( 1..3443 ) {
#foreach my $i ( 1..5000 ) {
#foreach my $i ( 1..29362 ) {
#foreach my $i ( 1..33331 ) {
#foreach my $i ( 1..83268 ) {
foreach my $i ( 1..200000 ) {
foreach my $i (1 .. 200000)
{
my @sect;
if ( rand() < 0.7 ) {
$sect[0] = int( (rand()**4)*100 );
} else {
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;
}
}
......@@ -64,12 +74,13 @@ EOT
unlink 'message.tmp', 'message_section_map.tmp';
sub copytable {
sub copytable
{
my $t = shift;
print "COPY $t from stdin;\n";
open( FFF, "$t.tmp") || die;
while(<FFF>) { print; }
open(FFF, "$t.tmp") || die;
while (<FFF>) { print; }
close FFF;
print "\\.\n";
}
contrib/seg/seg-validate.pl
View file @ 042d9ffc
......@@ -2,12 +2,12 @@
$integer = '[+-]?[0-9]+';
$real = '[+-]?[0-9]+\.[0-9]+';
$RANGE = '(\.\.)(\.)?';
$PLUMIN = q(\'\+\-\');
$FLOAT = "(($integer)|($real))([eE]($integer))?";
$RANGE = '(\.\.)(\.)?';
$PLUMIN = q(\'\+\-\');
$FLOAT = "(($integer)|($real))([eE]($integer))?";
$EXTENSION = '<|>|~';
$boundary = "($EXTENSION)?$FLOAT";
$boundary = "($EXTENSION)?$FLOAT";
$deviation = $FLOAT;
$rule_1 = $boundary . $PLUMIN . $deviation;
......@@ -18,25 +18,33 @@ $rule_5 = $boundary;
print "$rule_5\n";
while (<>) {
# s/ +//g;
if ( /^($rule_1)$/ ) {
print;
}
elsif ( /^($rule_2)$/ ) {
print;
}
elsif ( /^($rule_3)$/ ) {
print;
}
elsif ( /^($rule_4)$/ ) {
print;
}
elsif ( /^($rule_5)$/ ) {
print;
}
else {
print STDERR "error in $_\n";
}
while (<>)
{
# s/ +//g;
if (/^($rule_1)$/)
{
print;
}
elsif (/^($rule_2)$/)
{
print;
}
elsif (/^($rule_3)$/)
{
print;
}
elsif (/^($rule_4)$/)
{
print;
}
elsif (/^($rule_5)$/)
{
print;
}
else
{
print STDERR "error in $_\n";
}
}
contrib/seg/sort-segments.pl
View file @ 042d9ffc
......@@ -2,19 +2,22 @@
# this script will sort any table with the segment data type in its last column
while (<>) {
chomp;
push @rows, $_;
while (<>)
{
chomp;
push @rows, $_;
}
foreach ( sort {
@ar = split("\t", $a);
$valA = pop @ar;
$valA =~ s/[~<> ]+//g;
@ar = split("\t", $b);
$valB = pop @ar;
$valB =~ s/[~<> ]+//g;
$valA <=> $valB
} @rows ) {
print "$_\n";;
foreach (
sort {
@ar = split("\t", $a);
$valA = pop @ar;
$valA =~ s/[~<> ]+//g;
@ar = split("\t", $b);
$valB = pop @ar;
$valB =~ s/[~<> ]+//g;
$valA <=> $valB
} @rows)
{
print "$_\n";
}
doc/src/sgml/generate-errcodes-table.pl
View file @ 042d9ffc
......@@ -6,51 +6,54 @@
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/-/&mdash;/;
# 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/-/&mdash;/;
# 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;
doc/src/sgml/generate_history.pl
View file @ 042d9ffc
......@@ -25,34 +25,41 @@ process_file($infile);
exit 0;
sub process_file {
my $filename = shift;
sub process_file
{
my $filename = shift;
local *FILE; # need a local filehandle so we can recurse
local *FILE; # need a local filehandle so we can recurse
my $f = $srcdir . '/' . $filename;
open(FILE, $f) || die "could not read $f: $!\n";
my $f = $srcdir . '/' . $filename;
open(FILE, $f) || die "could not read $f: $!\n";
while (<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);
}
doc/src/sgml/mk_feature_tables.pl
View file @ 042d9ffc
......@@ -8,14 +8,18 @@ open PACK, $ARGV[1] or die;
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;
......@@ -24,33 +28,41 @@ open FEAT, $ARGV[2] or die;
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/</&lt;/g;
$feature_name =~ s/>/&gt;/g;
$subfeature_name =~ s/</&lt;/g;
$subfeature_name =~ s/>/&gt;/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/</&lt;/g;
$feature_name =~ s/>/&gt;/g;
$subfeature_name =~ s/</&lt;/g;
$subfeature_name =~ s/>/&gt;/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";
......
src/backend/catalog/Catalog.pm
View file @ 042d9ffc
This diff is collapsed.
src/backend/catalog/genbki.pl
View file @ 042d9ffc
This diff is collapsed.
src/backend/utils/Gen_fmgrtab.pl
View file @ 042d9ffc
......@@ -19,29 +19,29 @@ use strict;
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.
......@@ -50,48 +50,47 @@ my $catalogs = Catalog::Catalogs($infile);
# Collect the raw data from pg_proc.h.
my @fmgr = ();
my @attnames;
foreach my $column ( @{ $catalogs->{pg_proc}->{columns} } )
foreach my $column (@{ $catalogs->{pg_proc}->{columns} })
{
push @attnames, keys %$column;
push @attnames, keys %$column;
}
my $data = $catalogs->{pg_proc}->{data};
foreach my $row (@$data)
{
# To construct fmgroids.h and fmgrtab.c, we need to inspect some
# of the individual data fields. Just splitting on whitespace
# won't work, because some quoted fields might contain internal
# whitespace. We handle this by folding them all to a simple
# "xxx". Fortunately, this script doesn't need to look at any
# fields that might need quoting, so this simple hack is
# sufficient.
$row->{bki_values} =~ s/"[^"]*"/"xxx"/g;
@{$row}{@attnames} = split /\s+/, $row->{bki_values};
# Select out just the rows for internal-language procedures.
# Note assumption here that INTERNALlanguageId is 12.
next if $row->{prolang} ne '12';
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|/*-------------------------------------------------------------------------
......@@ -160,12 +159,12 @@ qq|/*-------------------------------------------------------------------------
# Emit #define's and extern's -- only one per prosrc value
my %seenit;
foreach my $s (sort {$a->{oid} <=> $b->{oid}} @fmgr)
foreach my $s (sort { $a->{oid} <=> $b->{oid} } @fmgr)
{
next if $seenit{$s->{prosrc}};
$seenit{$s->{prosrc}} = 1;
print H "#define F_" . uc $s->{prosrc} . " $s->{oid}\n";
print T "extern Datum $s->{prosrc} (PG_FUNCTION_ARGS);\n";
next if $seenit{ $s->{prosrc} };
$seenit{ $s->{prosrc} } = 1;
print H "#define F_" . uc $s->{prosrc} . " $s->{oid}\n";
print T "extern Datum $s->{prosrc} (PG_FUNCTION_ARGS);\n";
}
# Create the fmgr_builtins table
......@@ -173,10 +172,10 @@ print T "\nconst FmgrBuiltin fmgr_builtins[] = {\n";
my %bmap;
$bmap{'t'} = 'true';
$bmap{'f'} = 'false';
foreach my $s (sort {$a->{oid} <=> $b->{oid}} @fmgr)
foreach my $s (sort { $a->{oid} <=> $b->{oid} } @fmgr)
{
print T
" { $s->{oid}, \"$s->{prosrc}\", $s->{nargs}, $bmap{$s->{strict}}, $bmap{$s->{retset}}, $s->{prosrc} },\n";
print T
" { $s->{oid}, \"$s->{prosrc}\", $s->{nargs}, $bmap{$s->{strict}}, $bmap{$s->{retset}}, $s->{prosrc} },\n";
}
# And add the file footers.
......@@ -198,11 +197,11 @@ close(T);
# Finally, rename the completed files into place.
Catalog::RenameTempFile($oidsfile, $tmpext);
Catalog::RenameTempFile($tabfile, $tmpext);
Catalog::RenameTempFile($tabfile, $tmpext);
sub usage
{
die <<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
......
src/backend/utils/generate-errcodes.pl
View file @ 042d9ffc
......@@ -6,36 +6,41 @@
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;
src/backend/utils/mb/Unicode/UCS_to_BIG5.pl
View file @ 042d9ffc
......@@ -33,68 +33,82 @@ require "ucs2utf.pl";
#
$in_file = "BIG5.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" );
open(FILE, $in_file) || die("cannot open $in_file");
reset 'array';
while( <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;
}
}
......@@ -107,67 +121,81 @@ close(FILE);
#
$in_file = "BIG5.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" );
open(FILE, $in_file) || die("cannot open $in_file");
reset 'array';
while( <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;
}
}
......
src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl
View file @ 042d9ffc
......@@ -22,43 +22,51 @@ require "ucs2utf.pl";
$in_file = "GB2312.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" );
open(FILE, $in_file) || die("cannot open $in_file");
while( <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;
}
}
......@@ -71,39 +79,47 @@ close(FILE);
#
reset 'array';
open( FILE, $in_file ) || die( "cannot open $in_file" );
open(FILE, $in_file) || die("cannot open $in_file");
while( <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;
}
}
......
src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl
View file @ 042d9ffc
......@@ -36,102 +36,118 @@ require "ucs2utf.pl";
#
$in_file = "JIS0201.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" );
open(FILE, $in_file) || die("cannot open $in_file");
reset 'array';
while( <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;
}
}
......@@ -148,100 +164,116 @@ close(FILE);
#
$in_file = "JIS0201.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" );
open(FILE, $in_file) || die("cannot open $in_file");
reset 'array';
while( <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;
}
}
......
src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl
View file @ 042d9ffc
......@@ -22,43 +22,51 @@ require "ucs2utf.pl";
$in_file = "KSX1001.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" );
open(FILE, $in_file) || die("cannot open $in_file");
while( <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;
}
}
......@@ -71,39 +79,47 @@ close(FILE);
#
reset 'array';
open( FILE, $in_file ) || die( "cannot open $in_file" );
open(FILE, $in_file) || die("cannot open $in_file");
while( <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;
}
}
......
src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl
View file @ 042d9ffc
......@@ -23,53 +23,66 @@ require "ucs2utf.pl";
$in_file = "CNS11643.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" );
open(FILE, $in_file) || die("cannot open $in_file");
while( <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;
}
}
......@@ -82,50 +95,60 @@ close(FILE);
#
reset 'array';
open( FILE, $in_file ) || die( "cannot open $in_file" );
open(FILE, $in_file) || die("cannot open $in_file");
while( <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;
}
}
......
src/backend/utils/mb/Unicode/UCS_to_GB18030.pl
View file @ 042d9ffc
......@@ -18,28 +18,32 @@ require "ucs2utf.pl";
$in_file = "ISO10646-GB18030.TXT";
open( FILE, $in_file ) || die( "cannot open $in_file" );
open(FILE, $in_file) || die("cannot open $in_file");
while( <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);
#
......@@ -47,15 +51,19 @@ close( FILE );
#
$file = "utf8_to_gb18030.map";
open( FILE, "> $file" ) || die( "cannot open $file" );
open(FILE, "> $file") || die("cannot open $file");
print FILE "static pg_utf_to_local ULmapGB18030[ $count ] = {\n";
for $index ( sort {$a <=> $b} keys( %array ) ){
$code = $array{ $index };
for $index (sort { $a <=> $b } keys(%array))
{
$code = $array{$index};
$count--;
if( $count == 0 ){
if ($count == 0)
{
printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
} else {
}
else
{
printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
}
}
......@@ -69,38 +77,46 @@ close(FILE);
#
reset 'array';
open( FILE, $in_file ) || die( "cannot open $in_file" );
open(FILE, $in_file) || die("cannot open $in_file");
while( <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;
}
}
......
src/backend/utils/mb/Unicode/UCS_to_SHIFT_JIS_2004.pl
View file @ 042d9ffc
......@@ -13,65 +13,80 @@ require "ucs2utf.pl";
$in_file = "sjis-0213-2004-std.txt";
open( FILE, $in_file ) || die( "cannot open $in_file" );
open(FILE, $in_file) || die("cannot open $in_file");
reset 'array';
reset 'array1';
reset 'comment';
reset 'comment1';
while($line = <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};
}
}
......@@ -79,19 +94,27 @@ print FILE "};\n";
close(FILE);
$file = "utf8_to_shift_jis_2004_combined.map";
open( FILE, "> $file" ) || die( "cannot open $file" );
open(FILE, "> $file") || die("cannot open $file");
print FILE "/*\n";
print FILE " * This file was generated by UCS_to_SHIFT_JIS_2004.pl\n";
print FILE " */\n";
print FILE "static pg_utf_to_local_combined ULmapSHIFT_JIS_2004_combined[] = {\n";
print FILE
"static pg_utf_to_local_combined ULmapSHIFT_JIS_2004_combined[] = {\n";
for $index ( sort {$a cmp $b} keys( %array1 ) ){
$code = $array1{ $index };
for $index (sort { $a cmp $b } keys(%array1))
{
$code = $array1{$index};
$count1--;
if( $count1 == 0 ){
printf FILE " {0x%s, 0x%s, 0x%04x} /* %s */\n", substr($index, 0, 8), substr($index, 8, 8), $code, $comment1{ $index };
} else {
printf FILE " {0x%s, 0x%s, 0x%04x}, /* %s */\n", substr($index, 0, 8), substr($index, 8, 8), $code, $comment1{ $index };
if ($count1 == 0)
{
printf FILE " {0x%s, 0x%s, 0x%04x} /* %s */\n", substr($index, 0, 8),
substr($index, 8, 8), $code, $comment1{$index};
}
else
{
printf FILE " {0x%s, 0x%s, 0x%04x}, /* %s */\n",
substr($index, 0, 8), substr($index, 8, 8), $code,
$comment1{$index};
}
}
......@@ -102,66 +125,81 @@ close(FILE);
$in_file = "sjis-0213-2004-std.txt";
open( FILE, $in_file ) || die( "cannot open $in_file" );
open(FILE, $in_file) || die("cannot open $in_file");
reset 'array';
reset 'array1';
reset 'comment';
reset 'comment1';
while($line = <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};
}
}
......@@ -169,19 +207,26 @@ print FILE "};\n";
close(FILE);
$file = "shift_jis_2004_to_utf8_combined.map";
open( FILE, "> $file" ) || die( "cannot open $file" );
open(FILE, "> $file") || die("cannot open $file");
print FILE "/*\n";
print FILE " * This file was generated by UCS_to_SHIFT_JIS_2004.pl\n";
print FILE " */\n";
print FILE "static pg_local_to_utf_combined LUmapSHIFT_JIS_2004_combined[] = {\n";
print FILE
"static pg_local_to_utf_combined LUmapSHIFT_JIS_2004_combined[] = {\n";
for $index ( sort {$a <=> $b} keys( %array1 ) ){
$code = $array1{ $index };
for $index (sort { $a <=> $b } keys(%array1))
{
$code = $array1{$index};
$count1--;
if( $count1 == 0 ){
printf FILE " {0x%04x, 0x%s, 0x%s} /* %s */\n", $index, substr($code, 0, 8), substr($code, 8, 8), $comment1{ $index };
} else {
printf FILE " {0x%04x, 0x%s, 0x%s}, /* %s */\n", $index, substr($code, 0, 8), substr($code, 8, 8), $comment1{ $index };
if ($count1 == 0)
{
printf FILE " {0x%04x, 0x%s, 0x%s} /* %s */\n", $index,
substr($code, 0, 8), substr($code, 8, 8), $comment1{$index};
}
else
{
printf FILE " {0x%04x, 0x%s, 0x%s}, /* %s */\n", $index,
substr($code, 0, 8), substr($code, 8, 8), $comment1{$index};
}
}
......
src/backend/utils/mb/Unicode/UCS_to_SJIS.pl
View file @ 042d9ffc
......@@ -22,60 +22,68 @@ require "ucs2utf.pl";
# first generate UTF-8 --> SJIS table
$in_file = "CP932.TXT";
$count = 0;
$count = 0;
open(FILE, $in_file) || die("cannot open $in_file");
open( FILE, $in_file ) || die( "cannot open $in_file" );
while( <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;
}
}
......@@ -87,37 +95,44 @@ close(FILE);
# then generate SJIS --> UTF8 table
#
open( FILE, $in_file ) || die( "cannot open $in_file" );
open(FILE, $in_file) || die("cannot open $in_file");
reset 'array';
$count = 0;
while( <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;
}
}
......
src/backend/utils/mb/Unicode/UCS_to_most.pl
View file @ 042d9ffc
......@@ -18,80 +18,88 @@
require "ucs2utf.pl";
%filename = (
'WIN866' => 'CP866.TXT',
'WIN874' => 'CP874.TXT',
'WIN1250' => 'CP1250.TXT',
'WIN1251' => 'CP1251.TXT',
'WIN1252' => 'CP1252.TXT',
'WIN1253' => 'CP1253.TXT',
'WIN1254' => 'CP1254.TXT',
'WIN1255' => 'CP1255.TXT',
'WIN1256' => 'CP1256.TXT',
'WIN1257' => 'CP1257.TXT',
'WIN1258' => 'CP1258.TXT',
'ISO8859_2' => '8859-2.TXT',
'ISO8859_3' => '8859-3.TXT',
'ISO8859_4' => '8859-4.TXT',
'ISO8859_5' => '8859-5.TXT',
'ISO8859_6' => '8859-6.TXT',
'ISO8859_7' => '8859-7.TXT',
'ISO8859_8' => '8859-8.TXT',
'ISO8859_9' => '8859-9.TXT',
'WIN866' => 'CP866.TXT',
'WIN874' => 'CP874.TXT',
'WIN1250' => 'CP1250.TXT',
'WIN1251' => 'CP1251.TXT',
'WIN1252' => 'CP1252.TXT',
'WIN1253' => 'CP1253.TXT',
'WIN1254' => 'CP1254.TXT',
'WIN1255' => 'CP1255.TXT',
'WIN1256' => 'CP1256.TXT',
'WIN1257' => 'CP1257.TXT',
'WIN1258' => 'CP1258.TXT',
'ISO8859_2' => '8859-2.TXT',
'ISO8859_3' => '8859-3.TXT',
'ISO8859_4' => '8859-4.TXT',
'ISO8859_5' => '8859-5.TXT',
'ISO8859_6' => '8859-6.TXT',
'ISO8859_7' => '8859-7.TXT',
'ISO8859_8' => '8859-8.TXT',
'ISO8859_9' => '8859-9.TXT',
'ISO8859_10' => '8859-10.TXT',
'ISO8859_13' => '8859-13.TXT',
'ISO8859_14' => '8859-14.TXT',
'ISO8859_15' => '8859-15.TXT',
'ISO8859_16' => '8859-16.TXT',
'KOI8R' => 'KOI8-R.TXT',
'KOI8U' => 'KOI8-U.TXT',
'GBK' => 'CP936.TXT',
'UHC' => 'CP949.TXT',
'JOHAB' => 'JOHAB.TXT',
);
'KOI8R' => 'KOI8-R.TXT',
'KOI8U' => 'KOI8-U.TXT',
'GBK' => 'CP936.TXT',
'UHC' => 'CP949.TXT',
'JOHAB' => 'JOHAB.TXT',);
@charsets = keys(filename);
@charsets = @ARGV if scalar(@ARGV);
foreach $charset (@charsets) {
foreach $charset (@charsets)
{
#
# first, generate UTF8-> charset table
#
$in_file = $filename{$charset};
#
# first, generate UTF8-> charset table
#
$in_file = $filename{$charset};
open( FILE, $in_file ) || die( "cannot open $in_file" );
open(FILE, $in_file) || die("cannot open $in_file");
reset 'array';
while( <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;
}
}
......@@ -99,42 +107,50 @@ foreach $charset (@charsets) {
print FILE "};\n";
close(FILE);
#
# then generate character set code ->UTF8 table
#
open( FILE, $in_file ) || die( "cannot open $in_file" );
#
# then generate character set code ->UTF8 table
#
open(FILE, $in_file) || die("cannot open $in_file");
reset 'array';
while( <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
View file @ 042d9ffc
......@@ -4,24 +4,32 @@
# src/backend/utils/mb/Unicode/ucs2utf.pl
# convert UCS-4 to UTF-8
#
sub ucs2utf {
local($ucs) = @_;
sub ucs2utf
{
local ($ucs) = @_;
local $utf;
if ($ucs <= 0x007f) {
if ($ucs <= 0x007f)
{
$utf = $ucs;
} elsif ($ucs > 0x007f && $ucs <= 0x07ff) {
}
elsif ($ucs > 0x007f && $ucs <= 0x07ff)
{
$utf = (($ucs & 0x003f) | 0x80) | ((($ucs >> 6) | 0xc0) << 8);
} elsif ($ucs > 0x07ff && $ucs <= 0xffff) {
$utf = ((($ucs >> 12) | 0xe0) << 16) |
(((($ucs & 0x0fc0) >> 6) | 0x80) << 8) |
(($ucs & 0x003f) | 0x80);
} else {
$utf = ((($ucs >> 18) | 0xf0) << 24) |
(((($ucs & 0x3ffff) >> 12) | 0x80) << 16) |
(((($ucs & 0x0fc0) >> 6) | 0x80) << 8) |
(($ucs & 0x003f) | 0x80);
}
return($utf);
}
elsif ($ucs > 0x07ff && $ucs <= 0xffff)
{
$utf =
((($ucs >> 12) | 0xe0) << 16) |
(((($ucs & 0x0fc0) >> 6) | 0x80) << 8) | (($ucs & 0x003f) | 0x80);
}
else
{
$utf =
((($ucs >> 18) | 0xf0) << 24) |
(((($ucs & 0x3ffff) >> 12) | 0x80) << 16) |
(((($ucs & 0x0fc0) >> 6) | 0x80) << 8) | (($ucs & 0x003f) | 0x80);
}
return ($utf);
}
1;
src/backend/utils/sort/gen_qsort_tuple.pl
View file @ 042d9ffc
......@@ -32,16 +32,16 @@ my $CMPPARAMS;
emit_qsort_boilerplate();
$SUFFIX = 'tuple';
$EXTRAARGS = ', SortTupleComparator cmp_tuple, Tuplesortstate *state';
$SUFFIX = 'tuple';
$EXTRAARGS = ', SortTupleComparator cmp_tuple, Tuplesortstate *state';
$EXTRAPARAMS = ', cmp_tuple, state';
$CMPPARAMS = ', state';
$CMPPARAMS = ', state';
emit_qsort_implementation();
$SUFFIX = 'ssup';
$EXTRAARGS = ', SortSupport ssup';
$SUFFIX = 'ssup';
$EXTRAARGS = ', SortSupport ssup';
$EXTRAPARAMS = ', ssup';
$CMPPARAMS = ', ssup';
$CMPPARAMS = ', ssup';
print <<'EOM';
#define cmp_ssup(a, b, ssup) \
ApplySortComparator((a)->datum1, (a)->isnull1, \
......
src/bin/psql/create_help.pl
View file @ 042d9ffc
......@@ -22,15 +22,18 @@
use strict;
my $docdir = $ARGV[0] or die "$0: missing required argument: docdir\n";
my $hfile = $ARGV[1] . '.h' or die "$0: missing required argument: output file\n";
my $hfile = $ARGV[1] . '.h'
or die "$0: missing required argument: output file\n";
my $cfile = $ARGV[1] . '.c';
my $hfilebasename;
if ($hfile =~ m!.*/([^/]+)$!) {
$hfilebasename = $1;
if ($hfile =~ m!.*/([^/]+)$!)
{
$hfilebasename = $1;
}
else {
$hfilebasename = $hfile;
else
{
$hfilebasename = $hfile;
}
my $define = $hfilebasename;
......@@ -38,14 +41,13 @@ $define =~ tr/a-z/A-Z/;
$define =~ s/\W/_/g;
opendir(DIR, $docdir)
or die "$0: could not open documentation source dir '$docdir': $!\n";
or die "$0: could not open documentation source dir '$docdir': $!\n";
open(HFILE, ">$hfile")
or die "$0: could not open output file '$hfile': $!\n";
or die "$0: could not open output file '$hfile': $!\n";
open(CFILE, ">$cfile")
or die "$0: could not open output file '$cfile': $!\n";
or die "$0: could not open output file '$cfile': $!\n";
print HFILE
"/*
print HFILE "/*
* *** Do not change this file by hand. It is automatically
* *** generated from the DocBook documentation.
*
......@@ -72,8 +74,7 @@ struct _helpStruct
";
print CFILE
"/*
print CFILE "/*
* *** Do not change this file by hand. It is automatically
* *** generated from the DocBook documentation.
*
......@@ -90,71 +91,90 @@ my $maxlen = 0;
my %entries;
foreach my $file (sort readdir DIR) {
my (@cmdnames, $cmddesc, $cmdsynopsis);
$file =~ /\.sgml$/ or next;
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) . ");
}
";
......@@ -164,10 +184,11 @@ print HFILE "
static const struct _helpStruct QL_HELP[] = {
";
foreach (sort keys %entries) {
my $id = $_;
$id =~ s/ /_/g;
print HFILE " { \"$_\",
foreach (sort keys %entries)
{
my $id = $_;
$id =~ s/ /_/g;
print HFILE " { \"$_\",
N_(\"$entries{$_}{cmddesc}\"),
sql_help_$id,
$entries{$_}{nl_count} },
......@@ -180,7 +201,9 @@ print HFILE "
};
#define QL_HELP_COUNT ".scalar(keys %entries)." /* number of help items */
#define QL_HELP_COUNT "
. scalar(keys %entries)
. " /* number of help items */
#define QL_MAX_CMD_LEN $maxlen /* largest strlen(cmd) */
......
src/interfaces/ecpg/preproc/check_rules.pl
View file @ 042d9ffc
......@@ -6,7 +6,7 @@
# 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.
#
......@@ -25,7 +25,7 @@ if ($ARGV[0] eq '-v')
{
$verbose = shift;
}
my $path = shift || '.';
my $path = shift || '.';
my $parser = shift || '../../../backend/parser/gram.y';
my $filename = $path . "/ecpg.addons";
......@@ -37,32 +37,31 @@ if ($verbose)
my %replace_line = (
'ExecuteStmtEXECUTEnameexecute_param_clause' =>
'EXECUTE prepared_name execute_param_clause execute_rest',
'EXECUTE prepared_name execute_param_clause execute_rest',
'ExecuteStmtCREATEOptTempTABLEcreate_as_targetASEXECUTEnameexecute_param_clause' =>
'CREATE OptTemp TABLE create_as_target AS EXECUTE prepared_name execute_param_clause',
'ExecuteStmtCREATEOptTempTABLEcreate_as_targetASEXECUTEnameexecute_param_clause'
=> 'CREATE OptTemp TABLE create_as_target AS EXECUTE prepared_name execute_param_clause',
'PrepareStmtPREPAREnameprep_type_clauseASPreparableStmt' =>
'PREPARE prepared_name prep_type_clause AS PreparableStmt'
);
'PREPARE prepared_name prep_type_clause AS PreparableStmt');
my $block = '';
my $yaccmode = 0;
my $brace_indent = 0;
my (@arr, %found);
my $comment = 0;
my $comment = 0;
my $non_term_id = '';
my $cc = 0;
my $cc = 0;
open GRAM, $parser or die $!;
while (<GRAM>)
while (<GRAM>)
{
if (/^%%/)
if (/^%%/)
{
$yaccmode++;
}
if ( $yaccmode != 1 )
if ($yaccmode != 1)
{
next;
}
......@@ -80,50 +79,51 @@ while (<GRAM>)
s|\*\/| */ |g;
# Now split the line into individual fields
my $n = ( @arr = split( ' ' ) );
my $n = (@arr = split(' '));
# Go through each field in turn
for ( my $fieldIndexer = 0 ; $fieldIndexer < $n ; $fieldIndexer++ )
for (my $fieldIndexer = 0; $fieldIndexer < $n; $fieldIndexer++)
{
if ( $arr[$fieldIndexer] eq '*/' && $comment )
if ($arr[$fieldIndexer] eq '*/' && $comment)
{
$comment = 0;
next;
}
elsif ($comment)
elsif ($comment)
{
next;
}
elsif ( $arr[$fieldIndexer] eq '/*' )
elsif ($arr[$fieldIndexer] eq '/*')
{
# start of a multiline comment
$comment = 1;
next;
}
elsif ( $arr[$fieldIndexer] eq '//' )
elsif ($arr[$fieldIndexer] eq '//')
{
next;
}
elsif ( $arr[$fieldIndexer] eq '}' )
elsif ($arr[$fieldIndexer] eq '}')
{
$brace_indent--;
next;
}
elsif ( $arr[$fieldIndexer] eq '{' )
elsif ($arr[$fieldIndexer] eq '{')
{
$brace_indent++;
next;
}
if ( $brace_indent > 0 )
if ($brace_indent > 0)
{
next;
}
if ( $arr[$fieldIndexer] eq ';' || $arr[$fieldIndexer] eq '|' )
if ($arr[$fieldIndexer] eq ';' || $arr[$fieldIndexer] eq '|')
{
$block = $non_term_id . $block;
if ( $replace_line{$block} )
if ($replace_line{$block})
{
$block = $non_term_id . $replace_line{$block};
$block =~ tr/ |//d;
......@@ -132,13 +132,13 @@ while (<GRAM>)
$cc++;
$block = '';
}
elsif ( ( $arr[$fieldIndexer] =~ '[A-Za-z0-9]+:' )
|| $arr[ $fieldIndexer + 1 ] eq ':' )
elsif (($arr[$fieldIndexer] =~ '[A-Za-z0-9]+:')
|| $arr[ $fieldIndexer + 1 ] eq ':')
{
$non_term_id = $arr[$fieldIndexer];
$non_term_id =~ tr/://d;
}
else
else
{
$block = $block . $arr[$fieldIndexer];
}
......@@ -155,16 +155,16 @@ my $ret = 0;
$cc = 0;
open ECPG, $filename or die $!;
while (<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;
......
src/interfaces/ecpg/preproc/parse.pl
View file @ 042d9ffc
This diff is collapsed.
src/pl/plperl/plc_perlboot.pl
View file @ 042d9ffc
......@@ -7,99 +7,113 @@ PostgreSQL::InServer::Util::bootstrap();
# globals
sub ::is_array_ref {
sub ::is_array_ref
{
return ref($_[0]) =~ m/^(?:PostgreSQL::InServer::)?ARRAY$/;
}
sub ::encode_array_literal {
sub ::encode_array_literal
{
my ($arg, $delim) = @_;
return $arg unless(::is_array_ref($arg));
return $arg unless (::is_array_ref($arg));
$delim = ', ' unless defined $delim;
my $res = '';
foreach my $elem (@$arg) {
foreach my $elem (@$arg)
{
$res .= $delim if length $res;
if (ref $elem) {
if (ref $elem)
{
$res .= ::encode_array_literal($elem, $delim);
}
elsif (defined $elem) {
elsif (defined $elem)
{
(my $str = $elem) =~ s/(["\\])/\\$1/g;
$res .= qq("$str");
}
else {
else
{
$res .= 'NULL';
}
}
return qq({$res});
}
sub ::encode_array_constructor {
sub ::encode_array_constructor
{
my $arg = shift;
return ::quote_nullable($arg) unless ::is_array_ref($arg);
my $res = join ", ", map {
(ref $_) ? ::encode_array_constructor($_)
: ::quote_nullable($_)
} @$arg;
my $res = join ", ",
map { (ref $_) ? ::encode_array_constructor($_) : ::quote_nullable($_) }
@$arg;
return "ARRAY[$res]";
}
{
package PostgreSQL::InServer;
use strict;
use warnings;
sub plperl_warn {
(my $msg = shift) =~ s/\(eval \d+\) //g;
chomp $msg;
&::elog(&::WARNING, $msg);
}
$SIG{__WARN__} = \&plperl_warn;
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;
}
src/pl/plperl/plperl_opmask.pl
View file @ 042d9ffc
......@@ -5,54 +5,59 @@ use warnings;
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;
src/pl/plperl/text2macro.pl
View file @ 042d9ffc
......@@ -32,11 +32,10 @@ GetOptions(
'prefix=s' => \my $opt_prefix,
'name=s' => \my $opt_name,
'strip=s' => \my $opt_strip,
'selftest!' => sub { exit selftest() },
) or exit 1;
'selftest!' => sub { exit selftest() },) or exit 1;
die "No text files specified"
unless @ARGV;
unless @ARGV;
print qq{
/*
......@@ -45,17 +44,19 @@ print qq{
*/
};
for my $src_file (@ARGV) {
for my $src_file (@ARGV)
{
(my $macro = $src_file) =~ s/ .*? (\w+) (?:\.\w+) $/$1/x;
open my $src_fh, $src_file # not 3-arg form
or die "Can't open $src_file: $!";
open my $src_fh, $src_file # not 3-arg form
or die "Can't open $src_file: $!";
printf qq{#define %s%s \\\n},
$opt_prefix || '',
($opt_name) ? $opt_name : uc $macro;
while (<$src_fh>) {
$opt_prefix || '',
($opt_name) ? $opt_name : uc $macro;
while (<$src_fh>)
{
chomp;
next if $opt_strip and m/$opt_strip/o;
......@@ -74,8 +75,9 @@ print "/* end */\n";
exit 0;
sub selftest {
my $tmp = "text2macro_tmp";
sub selftest
{
my $tmp = "text2macro_tmp";
my $string = q{a '' '\\'' "" "\\"" "\\\\" "\\\\n" b};
open my $fh, ">$tmp.pl" or die;
......
src/pl/plpgsql/src/generate-plerrcodes.pl
View file @ 042d9ffc
......@@ -6,35 +6,35 @@
use warnings;
use strict;
print "/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n";
print
"/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n";
print "/* there is deliberately not an #ifndef PLERRCODES_H here */\n";
open my $errcodes, $ARGV[0] or die;
while (<$errcodes>) {
chomp;
while (<$errcodes>)
{
chomp;
# Skip comments
next if /^#/;
next if /^\s*$/;
# Skip comments
next if /^#/;
next if /^\s*$/;
# Skip section headers
next if /^Section:/;
# Skip section headers
next if /^Section:/;
die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/;
die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/;
(my $sqlstate,
my $type,
my $errcode_macro,
my $condition_name) = ($1, $2, $3, $4);
(my $sqlstate, my $type, my $errcode_macro, my $condition_name) =
($1, $2, $3, $4);
# Skip non-errors
next unless $type eq 'E';
# Skip non-errors
next unless $type eq 'E';
# Skip lines without PL/pgSQL condition names
next unless defined($condition_name);
# Skip lines without PL/pgSQL condition names
next unless defined($condition_name);
print "{\n\t\"$condition_name\", $errcode_macro\n},\n\n";
print "{\n\t\"$condition_name\", $errcode_macro\n},\n\n";
}
close $errcodes;
src/pl/plpython/generate-spiexceptions.pl
View file @ 042d9ffc
......@@ -6,39 +6,39 @@
use warnings;
use strict;
print "/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n";
print
"/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n";
print "/* there is deliberately not an #ifndef SPIEXCEPTIONS_H here */\n";
open my $errcodes, $ARGV[0] or die;
while (<$errcodes>) {
chomp;
while (<$errcodes>)
{
chomp;
# Skip comments
next if /^#/;
next if /^\s*$/;
# Skip comments
next if /^#/;
next if /^\s*$/;
# Skip section headers
next if /^Section:/;
# Skip section headers
next if /^Section:/;
die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/;
die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/;
(my $sqlstate,
my $type,
my $errcode_macro,
my $condition_name) = ($1, $2, $3, $4);
(my $sqlstate, my $type, my $errcode_macro, my $condition_name) =
($1, $2, $3, $4);
# Skip non-errors
next unless $type eq 'E';
# Skip non-errors
next unless $type eq 'E';
# Skip lines without PL/pgSQL condition names
next unless defined($condition_name);
# Skip lines without PL/pgSQL condition names
next unless defined($condition_name);
# Change some_error_condition to SomeErrorCondition
$condition_name =~ s/([a-z])([^_]*)(?:_|$)/\u$1$2/g;
# Change some_error_condition to SomeErrorCondition
$condition_name =~ s/([a-z])([^_]*)(?:_|$)/\u$1$2/g;
print "{ \"spiexceptions.$condition_name\", " .
"\"$condition_name\", $errcode_macro },\n";
print "{ \"spiexceptions.$condition_name\", "
. "\"$condition_name\", $errcode_macro },\n";
}
close $errcodes;
src/test/locale/sort-test.pl
View file @ 042d9ffc
......@@ -2,10 +2,10 @@
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";
src/test/performance/runtests.pl
View file @ 042d9ffc
......@@ -10,9 +10,9 @@ $DBNAME = 'perftest';
# This describtion for all DBMS supported by test
# DBMS_name => [FrontEnd, DestroyDB command, CreateDB command]
%DBMS = (
'pgsql' => ["psql -q -d $DBNAME", "destroydb $DBNAME", "createdb $DBNAME"]
);
%DBMS =
('pgsql' =>
[ "psql -q -d $DBNAME", "destroydb $DBNAME", "createdb $DBNAME" ]);
# Tests to run: test' script, test' description, ...
# Test' script is in form
......@@ -34,30 +34,37 @@ $DBNAME = 'perftest';
# an idea of what can be done for features unsupported by an DBMS.)
#
@perftests = (
# It speed up things
'connection.ntm', 'DB connection startup (no timing)',
# Just connection startup time (echo "" | psql ... - for PgSQL)
'connection', 'DB connection startup',
'crtsimple.ntm', 'Create SIMPLE table (no timing)',
# 8192 inserts in single xaction
'inssimple T', '8192 INSERTs INTO SIMPLE (1 xact)',
'drpsimple.ntm', 'Drop SIMPLE table (no timing)',
'crtsimple.ntm', 'Create SIMPLE table (no timing)',
# 8192 inserts in 8192 xactions
'inssimple', '8192 INSERTs INTO SIMPLE (8192 xacts)',
'vacuum.ntm', 'Vacuum (no timing)',
# Fast (after table filled with data) index creation test
'crtsimpleidx', 'Create INDEX on SIMPLE',
'drpsimple.ntm', 'Drop SIMPLE table (no timing)',
'crtsimple.ntm', 'Create SIMPLE table (no timing)',
'crtsimpleidx.ntm', 'Create INDEX on SIMPLE (no timing)',
# 8192 inserts in single xaction into table with index
'inssimple T', '8192 INSERTs INTO SIMPLE with INDEX (1 xact)',
# 8192 SELECT * FROM simple WHERE justint = <random_key> in single xaction
'slcsimple T', '8192 random INDEX scans on SIMPLE (1 xact)',
# SELECT * FROM simple ORDER BY justint
'orbsimple', 'ORDER BY SIMPLE',
);
# 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
......@@ -66,72 +73,76 @@ $DBNAME = 'perftest';
$TestDBMS = $ARGV[0];
die "Unsupported DBMS $TestDBMS\n" if !exists $DBMS{$TestDBMS};
$FrontEnd = $DBMS{$TestDBMS}[0];
$FrontEnd = $DBMS{$TestDBMS}[0];
$DestroyDB = $DBMS{$TestDBMS}[1];
$CreateDB = $DBMS{$TestDBMS}[2];
$CreateDB = $DBMS{$TestDBMS}[2];
print "(Re)create DataBase $DBNAME\n";
`$DestroyDB`; # Destroy DB
`$CreateDB`; # Create DB
`$DestroyDB`; # Destroy DB
`$CreateDB`; # Create DB
$ResFile = "Results.$TestDBMS";
$TmpFile = "Tmp.$TestDBMS";
open (SAVEOUT, ">&STDOUT");
open (STDOUT, ">/dev/null") or die;
open (SAVEERR, ">&STDERR");
open (STDERR, ">$TmpFile") or die;
select (STDERR); $| = 1;
open(SAVEOUT, ">&STDOUT");
open(STDOUT, ">/dev/null") or die;
open(SAVEERR, ">&STDERR");
open(STDERR, ">$TmpFile") or die;
select(STDERR);
$| = 1;
for ($i = 0; $i <= $#perftests; $i++)
{
$test = $perftests[$i];
($test, $XACTBLOCK) = split (/ /, $test);
($test, $XACTBLOCK) = split(/ /, $test);
$runtest = $test;
if ( $test =~ /\.ntm/ )
if ($test =~ /\.ntm/)
{
#
# No timing for this queries
#
close (STDERR); # close $TmpFile
open (STDERR, ">/dev/null") or die;
close(STDERR); # close $TmpFile
open(STDERR, ">/dev/null") or die;
$runtest =~ s/\.ntm//;
}
else
{
close (STDOUT);
close(STDOUT);
open(STDOUT, ">&SAVEOUT");
print STDOUT "\nRunning: $perftests[$i+1] ...";
close (STDOUT);
open (STDOUT, ">/dev/null") or die;
select (STDERR); $| = 1;
close(STDOUT);
open(STDOUT, ">/dev/null") or die;
select(STDERR);
$| = 1;
printf "$perftests[$i+1]: ";
}
do "sqls/$runtest";
# Restore STDERR to $TmpFile
if ( $test =~ /\.ntm/ )
if ($test =~ /\.ntm/)
{
close (STDERR);
open (STDERR, ">>$TmpFile") or die;
close(STDERR);
open(STDERR, ">>$TmpFile") or die;
}
select (STDERR); $| = 1;
select(STDERR);
$| = 1;
$i++;
}
close (STDERR);
close(STDERR);
open(STDERR, ">&SAVEERR");
open (TMPF, "<$TmpFile") or die;
open (RESF, ">$ResFile") or die;
open(TMPF, "<$TmpFile") or die;
open(RESF, ">$ResFile") or die;
while (<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";
}
src/tools/check_bison_recursion.pl
View file @ 042d9ffc
This diff is collapsed.
src/tools/check_keywords.pl
View file @ 042d9ffc
This diff is collapsed.
src/tools/copyright.pl
View file @ 042d9ffc
This diff is collapsed.
src/tools/msvc/Install.pm
View file @ 042d9ffc
This diff is collapsed.
src/tools/msvc/MSBuildProject.pm
View file @ 042d9ffc
This diff is collapsed.
src/tools/msvc/Mkvcbuild.pm
View file @ 042d9ffc
This diff is collapsed.
src/tools/msvc/Project.pm
View file @ 042d9ffc
This diff is collapsed.
src/tools/msvc/Solution.pm
View file @ 042d9ffc
This diff is collapsed.
src/tools/msvc/VCBuildProject.pm
View file @ 042d9ffc
This diff is collapsed.
src/tools/msvc/VSObjectFactory.pm
View file @ 042d9ffc
......@@ -17,7 +17,7 @@ use VCBuildProject;
use MSBuildProject;
our (@ISA, @EXPORT);
@ISA = qw(Exporter);
@ISA = qw(Exporter);
@EXPORT = qw(CreateSolution CreateProject DetermineVisualStudioVersion);
sub CreateSolution
......@@ -81,12 +81,12 @@ sub DetermineVisualStudioVersion
if (!defined($nmakeVersion))
{
# Determine version of nmake command, to set proper version of visual studio
# we use nmake as it has existed for a long time and still exists in visual studio 2010
open(P,"nmake /? 2>&1 |")
# Determine version of nmake command, to set proper version of visual studio
# we use nmake as it has existed for a long time and still exists in visual studio 2010
open(P, "nmake /? 2>&1 |")
|| croak
"Unable to determine Visual Studio version: The nmake command wasn't found.";
while(<P>)
"Unable to determine Visual Studio version: The nmake command wasn't found.";
while (<P>)
{
chomp;
if (/(\d+)\.(\d+)\.\d+(\.\d+)?$/)
......@@ -96,17 +96,17 @@ sub DetermineVisualStudioVersion
}
close(P);
}
elsif($nmakeVersion =~ /(\d+)\.(\d+)\.\d+(\.\d+)?$/)
elsif ($nmakeVersion =~ /(\d+)\.(\d+)\.\d+(\.\d+)?$/)
{
return _GetVisualStudioVersion($1, $2);
}
croak
"Unable to determine Visual Studio version: The nmake version could not be determined.";
"Unable to determine Visual Studio version: The nmake version could not be determined.";
}
sub _GetVisualStudioVersion
{
my($major, $minor) = @_;
my ($major, $minor) = @_;
if ($major > 10)
{
carp
......
src/tools/msvc/build.pl
View file @ 042d9ffc
This diff is collapsed.
src/tools/msvc/builddoc.pl
View file @ 042d9ffc
This diff is collapsed.
src/tools/msvc/config_default.pl
View file @ 042d9ffc
This diff is collapsed.
src/tools/msvc/gendef.pl
View file @ 042d9ffc
This diff is collapsed.
src/tools/msvc/mkvcbuild.pl
View file @ 042d9ffc
......@@ -10,10 +10,13 @@ use warnings;
use Mkvcbuild;
chdir('..\..\..') if (-d '..\msvc' && -d '..\..\..\src');
die 'Must run from root or msvc directory' unless (-d 'src\tools\msvc' && -d 'src');
die 'Must run from root or msvc directory'
unless (-d 'src\tools\msvc' && -d 'src');
die 'Could not find config_default.pl' unless (-f 'src/tools/msvc/config_default.pl');
print "Warning: no config.pl found, using default.\n" unless (-f 'src/tools/msvc/config.pl');
die 'Could not find config_default.pl'
unless (-f 'src/tools/msvc/config_default.pl');
print "Warning: no config.pl found, using default.\n"
unless (-f 'src/tools/msvc/config.pl');
our $config;
require 'src/tools/msvc/config_default.pl';
......
src/tools/msvc/pgbison.pl
View file @ 042d9ffc
This diff is collapsed.
src/tools/msvc/pgflex.pl
View file @ 042d9ffc
This diff is collapsed.
src/tools/msvc/vcregress.pl
View file @ 042d9ffc
This diff is collapsed.
src/tools/version_stamp.pl
View file @ 042d9ffc
This diff is collapsed.
src/tools/win32tzlist.pl
View file @ 042d9ffc
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment