Skip to content

P
Postgres FD Implementation
Commit 030a2831 authored by Peter Eisentraut's avatar Peter Eisentraut
Browse files
Options

Move parse2.pl to parse.pl 

We have a SCM, so we don't need to keep old versions of files around.
parent 2fccc881
Hide whitespace changes
Inline Side-by-side
Showing with 590 additions and 1089 deletions
src/interfaces/ecpg/preproc/Makefile
View file @ 030a2831
......@@ -57,8 +57,8 @@ else
@$(missing) flex $< $@
endif
preproc.y: ../../../backend/parser/gram.y parse2.pl ecpg.addons ecpg.header ecpg.tokens ecpg.trailer ecpg.type
$(PERL) $(srcdir)/parse2.pl $(srcdir) < $< > $@
preproc.y: ../../../backend/parser/gram.y parse.pl ecpg.addons ecpg.header ecpg.tokens ecpg.trailer ecpg.type
$(PERL) $(srcdir)/parse.pl $(srcdir) < $< > $@
$(PERL) $(srcdir)/check_rules.pl $(srcdir) $<
ecpg_keywords.o c_keywords.o keywords.o preproc.o parser.o: preproc.h
......
src/interfaces/ecpg/preproc/README.parser
View file @ 030a2831
......@@ -3,7 +3,7 @@ ECPG modifies and extends the core grammar in a way that
defined in ecpg.tokens, types are defined in ecpg.type
2) most tokens from the core grammar are simply converted
to literals concatenated together to form the SQL string
passed to the server, this is done by parse2.pl.
passed to the server, this is done by parse.pl.
3) some rules need side-effects, actions are either added
or completely overridden (compared to the basic token
concatenation) for them, these are defined in ecpg.addons,
......@@ -20,7 +20,7 @@ rules concatenated together. e.g. if gram.y has this:
ruleA: tokenA tokenB tokenC {...}
then "dumpedtokens" is "ruleAtokenAtokenBtokenC".
"postfix" above can be:
a) "block" - the automatic rule created by parse2.pl is completely
a) "block" - the automatic rule created by parse.pl is completely
overridden, the code block has to be written completely as
it were in a plain bison grammar
b) "rule" - the automatic rule is extended on, so new syntaxes
......
src/interfaces/ecpg/preproc/ecpg.trailer
View file @ 030a2831
......@@ -1591,7 +1591,7 @@ ECPGCKeywords: S_AUTO { $$ = mm_strdup("auto"); }
* CONNECTION can be added back in all_unreserved_keyword, but CURRENT and
* INPUT are reserved for ecpg purposes.
*
* The mentioned exclusions are done by $replace_line settings in parse2.pl.
* The mentioned exclusions are done by $replace_line settings in parse.pl.
*/
all_unreserved_keyword: unreserved_keyword { $$ = $1; }
| ECPGunreserved_interval { $$ = $1; }
......
src/interfaces/ecpg/preproc/parse.pl
View file @ 030a2831
#!/usr/bin/perl
# src/interfaces/ecpg/preproc/parse.pl
# parser generater for ecpg
# parser generater for ecpg version 2
# call with backend parser as stdin
#
# Copyright (c) 2007-2011, PostgreSQL Global Development Group
#
# Written by Mike Aubury <mike.aubury@aubit.com>
# Michael Meskes <meskes@postgresql.org>
# Andy Colson <andy@squeakycode.net>
#
# Placed under the same license as PostgreSQL.
#
if (@ARGV) {
$path = $ARGV[0];
shift @ARGV;
}
use strict;
use warnings;
no warnings 'uninitialized';
my $path = shift @ARGV;
$path = "." unless $path;
if ($path eq '') { $path = "."; }
my $copymode = 0;
my $brace_indent = 0;
my $yaccmode = 0;
my $header_included = 0;
my $feature_not_supported = 0;
my $tokenmode = 0;
$[ = 1; # set array base to 1
$, = ' '; # set output field separator
$\ = "\n"; # set output record separator
my(%buff, $infield, $comment, %tokens, %addons );
my($stmt_mode, @fields);
my($line, $non_term_id);
$copymode = 'off';
$brace_indent = 0;
$yaccmode = 0;
$header_included = 0;
$feature_not_supported = 0;
$tokenmode = 0;
# some token have to be replaced by other symbols
# either in the rule
$replace_token{'BCONST'} = 'ecpg_bconst';
$replace_token{'FCONST'} = 'ecpg_fconst';
$replace_token{'Sconst'} = 'ecpg_sconst';
$replace_token{'IDENT'} = 'ecpg_ident';
$replace_token{'PARAM'} = 'ecpg_param';
my %replace_token = (
'BCONST' => 'ecpg_bconst',
'FCONST' => 'ecpg_fconst',
'Sconst' => 'ecpg_sconst',
'IDENT' => 'ecpg_ident',
'PARAM' => 'ecpg_param',
);
# or in the block
$replace_string{'WITH_TIME'} = 'with time';
$replace_string{'NULLS_FIRST'} = 'nulls first';
$replace_string{'NULLS_LAST'} = 'nulls last';
$replace_string{'TYPECAST'} = '::';
$replace_string{'DOT_DOT'} = '..';
$replace_string{'COLON_EQUALS'} = ':=';
my %replace_string = (
'WITH_TIME' => 'with time',
'NULLS_FIRST' => 'nulls first',
'NULLS_LAST' => 'nulls last',
'TYPECAST' => '::',
'DOT_DOT' => '..',
'COLON_EQUALS' => ':=',
);
# specific replace_types for specific non-terminals - never include the ':'
# ECPG-only replace_types are defined in ecpg-replace_types
$replace_types{'PrepareStmt'} = '<prep>';
$replace_types{'opt_array_bounds'} = '<index>';
# "ignore" means: do not create type and rules for this non-term-id
$replace_types{'stmtblock'} = 'ignore';
$replace_types{'stmtmulti'} = 'ignore';
$replace_types{'CreateAsStmt'} = 'ignore';
$replace_types{'DeallocateStmt'} = 'ignore';
$replace_types{'ColId'} = 'ignore';
$replace_types{'type_function_name'} = 'ignore';
$replace_types{'ColLabel'} = 'ignore';
$replace_types{'Sconst'} = 'ignore';
my %replace_types = (
'PrepareStmt' => '<prep>',
'opt_array_bounds' => '<index>',
# "ignore" means: do not create type and rules for this non-term-id
'stmtblock' => 'ignore',
'stmtmulti' => 'ignore',
'CreateAsStmt' => 'ignore',
'DeallocateStmt' => 'ignore',
'ColId' => 'ignore',
'type_function_name' => 'ignore',
'ColLabel' => '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.
$replace_line{'unreserved_keywordCONNECTION'} = 'ignore';
$replace_line{'unreserved_keywordCURRENT_P'} = 'ignore';
$replace_line{'unreserved_keywordDAY_P'} = 'ignore';
$replace_line{'unreserved_keywordHOUR_P'} = 'ignore';
$replace_line{'unreserved_keywordINPUT_P'} = 'ignore';
$replace_line{'unreserved_keywordMINUTE_P'} = 'ignore';
$replace_line{'unreserved_keywordMONTH_P'} = 'ignore';
$replace_line{'unreserved_keywordSECOND_P'} = 'ignore';
$replace_line{'unreserved_keywordYEAR_P'} = 'ignore';
$replace_line{'col_name_keywordCHAR_P'} = 'ignore';
$replace_line{'col_name_keywordINT_P'} = 'ignore';
$replace_line{'col_name_keywordVALUES'} = 'ignore';
$replace_line{'reserved_keywordTO'} = 'ignore';
$replace_line{'reserved_keywordUNION'} = 'ignore';
# some other production rules have to be ignored or replaced
$replace_line{'fetch_argsFORWARDopt_from_incursor_name'} = 'ignore';
$replace_line{'fetch_argsBACKWARDopt_from_incursor_name'} = 'ignore';
$replace_line{"opt_array_boundsopt_array_bounds'['Iconst']'"} = 'ignore';
$replace_line{'VariableShowStmtSHOWvar_name'} = 'SHOW var_name ecpg_into';
$replace_line{'VariableShowStmtSHOWTIMEZONE'} = 'SHOW TIME ZONE ecpg_into';
$replace_line{'VariableShowStmtSHOWTRANSACTIONISOLATIONLEVEL'} = 'SHOW TRANSACTION ISOLATION LEVEL ecpg_into';
$replace_line{'VariableShowStmtSHOWSESSIONAUTHORIZATION'} = 'SHOW SESSION AUTHORIZATION ecpg_into';
$replace_line{'returning_clauseRETURNINGtarget_list'} = 'RETURNING target_list ecpg_into';
$replace_line{'ExecuteStmtEXECUTEnameexecute_param_clause'} = 'EXECUTE prepared_name execute_param_clause execute_rest';
$replace_line{'ExecuteStmtCREATEOptTempTABLEcreate_as_targetASEXECUTEnameexecute_param_clause'} = 'CREATE OptTemp TABLE create_as_target AS EXECUTE prepared_name execute_param_clause';
$replace_line{'PrepareStmtPREPAREnameprep_type_clauseASPreparableStmt'} = 'PREPARE prepared_name prep_type_clause AS PreparableStmt';
$replace_line{'var_nameColId'} = 'ECPGColId';
line: while (<>) {
chomp; # strip record separator
@Fld = split(' ', $_, -1);
# Dump the action for a rule -
# 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 (/ERRCODE_FEATURE_NOT_SUPPORTED/) {
$feature_not_supported = 1;
next line;
}
if (/^%%/) {
$tokenmode = 2;
$copymode = 'on';
$yaccmode++;
$infield = 0;
$fieldcount = 0;
}
$S = $_;
$prec = 0;
# 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;
# Now split the line into individual fields
$n = (@arr = split(' ', $S));
if ($arr[1] eq '%token' && $tokenmode == 0) {
$tokenmode = 1;
&include_stuff('tokens', 'ecpg.tokens', '', 1, 0);
$type = 1;
}
elsif ($arr[1] eq '%type' && $header_included == 0) {
&include_stuff('header', 'ecpg.header', '', 1, 0);
&include_stuff('ecpgtype', 'ecpg.type', '', 1, 0);
$header_included = 1;
}
if ($tokenmode == 1) {
$str = '';
for ($a = 1; $a <= $n; $a++) {
if ($arr[$a] eq '/*') {
$comment++;
next;
}
if ($arr[$a] eq '*/') {
$comment--;
next;
}
if ($comment) {
next;
}
if (substr($arr[$a], 1, 1) eq '<') {
next;
# its a type
}
$tokens{$arr[$a]} = 1;
$str = $str . ' ' . $arr[$a];
if ($arr[$a] eq 'IDENT' && $arr[$a - 1] eq '%nonassoc') {
# add two more tokens to the list
$str = $str . "\n%nonassoc CSTRING\n%nonassoc UIDENT";
}
}
&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) {
next line;
}
# Go through each field in turn
for ($fieldIndexer = 1; $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;
}
elsif ($arr[$fieldIndexer] eq '}') {
$brace_indent--;
next;
}
elsif ($arr[$fieldIndexer] eq '{') {
$brace_indent++;
next;
}
if ($brace_indent > 0) {
next;
}
if ($arr[$fieldIndexer] eq ';') {
if ($copymode eq 'on') {
if ($infield && $includetype eq '') {
&dump_line($stmt_mode, $fields, $field_count);
my %replace_line = (
'unreserved_keywordCONNECTION' => 'ignore',
'unreserved_keywordCURRENT_P' => 'ignore',
'unreserved_keywordDAY_P' => 'ignore',
'unreserved_keywordHOUR_P' => 'ignore',
'unreserved_keywordINPUT_P' => 'ignore',
'unreserved_keywordMINUTE_P' => 'ignore',
'unreserved_keywordMONTH_P' => 'ignore',
'unreserved_keywordSECOND_P' => 'ignore',
'unreserved_keywordYEAR_P' => 'ignore',
'col_name_keywordCHAR_P' => 'ignore',
'col_name_keywordINT_P' => 'ignore',
'col_name_keywordVALUES' => 'ignore',
'reserved_keywordTO' => 'ignore',
'reserved_keywordUNION' => 'ignore',
# some other production rules have to be ignored or replaced
'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',
'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',
);
preload_addons();
main();
dump_buffer('header');
dump_buffer('tokens');
dump_buffer('types');
dump_buffer('ecpgtype');
dump_buffer('orig_tokens');
print '%%', "\n";
print 'prog: statements;', "\n";
dump_buffer('rules');
include_file( 'trailer', 'ecpg.trailer' );
dump_buffer('trailer');
sub main
{
line: while (<>)
{
if (/ERRCODE_FEATURE_NOT_SUPPORTED/)
{
$feature_not_supported = 1;
next line;
}
&add_to_buffer('rules', ";\n\n");
}
else {
$copymode = 'on';
}
$field_count = 0;
$infield = 0;
$line = '';
$includetype = '';
next;
}
if ($arr[$fieldIndexer] eq '|') {
if ($copymode eq 'on') {
if ($infield && $includetype eq '') {
$infield = $infield + &dump_line($stmt_mode, $fields, $field_count);
}
if ($infield > 1) {
$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 (/^%%/) {
$tokenmode = 2;
$copymode = 1;
$yaccmode++;
$infield = 0;
}
}
$field_count = 0;
$includetype = '';
next;
}
if ($replace_token{$arr[$fieldIndexer]}) {
$arr[$fieldIndexer] = $replace_token{$arr[$fieldIndexer]};
}
my $prec = 0;
# Are we looking at a declaration of a non-terminal ?
if (($arr[$fieldIndexer] =~ '[A-Za-z0-9]+:') || $arr[$fieldIndexer + 1] eq ':') {
$non_term_id = $arr[$fieldIndexer];
$s = ':', $non_term_id =~ s/$s//g;
if ($replace_types{$non_term_id} eq '') {
$replace_types{$non_term_id} = '<str>';
}
if ($replace_types{$non_term_id} eq 'ignore') {
$copymode = ';';
$line = '';
next line;
}
else {
$copymode = 'on';
}
$line = $line . ' ' . $arr[$fieldIndexer];
# Do we have the : attached already ?
# If yes, we'll have already printed the ':'
if (!($arr[$fieldIndexer] =~ '[A-Za-z0-9]+:')) {
# Consume the ':' which is next...
$line = $line . ':';
$fieldIndexer++;
}
# Special mode?
if ($non_term_id eq 'stmt') {
$stmt_mode = 1;
}
else {
$stmt_mode = 0;
}
$tstr = '%type ' . $replace_types{$non_term_id} . ' ' . $non_term_id;
&add_to_buffer('types', $tstr);
if ($copymode eq 'on') {
&add_to_buffer('rules', $line);
}
$line = '';
$field_count = 0;
$infield = 1;
next;
}
elsif ($copymode eq 'on') {
$line = $line . ' ' . $arr[$fieldIndexer];
}
if ($arr[$fieldIndexer] eq '%prec') {
$prec = 1;
next;
}
# Make sure any braces are split
s/{/ { /g;
s/}/ } /g;
# Any comments are split
s|\/\*| /* |g;
s|\*\/| */ |g;
# Now split the line into individual fields
my @arr = split(' ');
if ($copymode eq 'on' && !$prec && !$comment && $arr[$fieldIndexer] ne '/*EMPTY*/' && length($arr[$fieldIndexer]) && $infield) {
$nfield = $field_count + 1;
if ($arr[$fieldIndexer] ne 'Op' && ($tokens{$arr[$fieldIndexer]} > 0 || $arr[$fieldIndexer] =~ "'.+'") || $stmt_mode == 1) {
if ($replace_string{$arr[$fieldIndexer]}) {
$S = $replace_string{$arr[$fieldIndexer]};
if ( $arr[0] eq '%token' && $tokenmode == 0 )
{
$tokenmode = 1;
include_file( 'tokens', 'ecpg.tokens' );
}
else {
$S = $arr[$fieldIndexer];
elsif ( $arr[0] eq '%type' && $header_included == 0 )
{
include_file( 'header', 'ecpg.header' );
include_file( 'ecpgtype', 'ecpg.type' );
$header_included = 1;
}
$s = '_P', $S =~ s/$s//g;
$s = "'", $S =~ s/$s//g;
if ($stmt_mode == 1) {
$fields{$field_count++} = $S;
if ( $tokenmode == 1 )
{
my $str = '';
my $prior = '';
for my $a (@arr)
{
if ( $a eq '/*' )
{
$comment++;
next;
}
if ( $a eq '*/' )
{
$comment--;
next;
}
if ($comment)
{
next;
}
if ( substr( $a, 0, 1 ) eq '<' ) {
next;
# its a type
}
$tokens{ $a } = 1;
$str = $str . ' ' . $a;
if ( $a eq 'IDENT' && $prior eq '%nonassoc' )
{
# add two more tokens to the list
$str = $str . "\n%nonassoc CSTRING\n%nonassoc UIDENT";
}
$prior = $a;
}
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 )
{
next line;
}
else {
$fields{$field_count++} = lc($S);
# Go through each field in turn
for (my $fieldIndexer = 0 ; $fieldIndexer < scalar(@arr) ; $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;
}
elsif ( $arr[$fieldIndexer] eq '}' )
{
$brace_indent--;
next;
}
elsif ( $arr[$fieldIndexer] eq '{' )
{
$brace_indent++;
next;
}
if ( $brace_indent > 0 )
{
next;
}
if ( $arr[$fieldIndexer] eq ';' )
{
if ($copymode)
{
if ( $infield )
{
dump_line( $stmt_mode, \@fields );
}
add_to_buffer( 'rules', ";\n\n" );
}
else
{
$copymode = 1;
}
@fields = ();
$infield = 0;
$line = '';
next;
}
if ( $arr[$fieldIndexer] eq '|' )
{
if ($copymode)
{
if ( $infield )
{
$infield = $infield + dump_line( $stmt_mode, \@fields );
}
if ( $infield > 1 )
{
$line = '| ';
}
}
@fields = ();
next;
}
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 ':' )
{
$non_term_id = $arr[$fieldIndexer];
$non_term_id =~ tr/://d;
if ( not defined $replace_types{$non_term_id} )
{
$replace_types{$non_term_id} = '<str>';
$copymode = 1;
}
elsif ( $replace_types{$non_term_id} eq 'ignore' )
{
$copymode = 0;
$line = '';
next line;
}
$line = $line . ' ' . $arr[$fieldIndexer];
# Do we have the : attached already ?
# If yes, we'll have already printed the ':'
if ( !( $arr[$fieldIndexer] =~ '[A-Za-z0-9]+:' ) )
{
# Consume the ':' which is next...
$line = $line . ':';
$fieldIndexer++;
}
# Special mode?
if ( $non_term_id eq 'stmt' )
{
$stmt_mode = 1;
}
else
{
$stmt_mode = 0;
}
my $tstr = '%type ' . $replace_types{$non_term_id} . ' ' . $non_term_id;
add_to_buffer( 'types', $tstr );
if ($copymode)
{
add_to_buffer( 'rules', $line );
}
$line = '';
@fields = ();
$infield = 1;
next;
}
elsif ($copymode) {
$line = $line . ' ' . $arr[$fieldIndexer];
}
if ( $arr[$fieldIndexer] eq '%prec' )
{
$prec = 1;
next;
}
if ( $copymode
&& !$prec
&& !$comment
&& length( $arr[$fieldIndexer] )
&& $infield )
{
if (
$arr[$fieldIndexer] ne 'Op'
&& ( $tokens{ $arr[$fieldIndexer] } > 0 || $arr[$fieldIndexer] =~ /'.+'/ )
|| $stmt_mode == 1
)
{
my $S;
if ( exists $replace_string{ $arr[$fieldIndexer] } )
{
$S = $replace_string{ $arr[$fieldIndexer] };
}
else
{
$S = $arr[$fieldIndexer];
}
$S =~ s/_P//g;
$S =~ tr/'//d;
if ( $stmt_mode == 1 )
{
push(@fields, $S);
}
else
{
push(@fields, lc($S));
}
}
else
{
push(@fields, '$' . (scalar(@fields)+1));
}
}
}
}
else {
$fields{$field_count++} = "\$" . $nfield;
}
}
}
}
&dump('header');
&dump('tokens');
&dump('types');
&dump('ecpgtype');
&dump('orig_tokens');
print '%%';
print 'prog: statements;';
&dump('rules');
&include_stuff('trailer', 'ecpg.trailer', '', 1, 0);
&dump('trailer');
sub include_stuff {
local($includestream, $includefilename, $includeblock, $copy, $field_count) = @_;
$copied = 0;
$inblock = 0;
$filename = $path . "/" . $includefilename;
while (($_ = &Getline2($filename),$getline_ok)) {
if ($includeblock ne '' && $Fld[1] eq 'ECPG:' && $inblock == 0) {
if ($Fld[2] eq $includeblock) {
$copy = 1;
$inblock = 1;
$includetype = $Fld[3];
if ($includetype eq 'rule') {
&dump_fields($stmt_mode, *fields, $field_count, ' { ');
}
elsif ($includetype eq 'addon') {
&add_to_buffer('rules', ' { ');
}
}
else {
$copy = 0;
}
# append a file onto a buffer.
# Arguments: buffer_name, filename (without path)
sub include_file
{
my ($buffer, $filename) = @_;
my $full = "$path/$filename";
open(my $fh, '<', $full) or die;
while ( <$fh> )
{
chomp;
add_to_buffer( $buffer, $_ );
}
else {
if ($copy == 1 && $Fld[1] ne 'ECPG:') {
&add_to_buffer($includestream, $_);
$copied = 1;
$inblock = 0;
}
close($fh);
}
sub include_addon
{
my($buffer, $block, $fields, $stmt_mode) = @_;
my $rec = $addons{$block};
return 0 unless $rec;
if ( $rec->{type} eq 'rule' )
{
dump_fields( $stmt_mode, $fields, ' { ' );
}
}
delete $opened{$filename} && close($filename);
if ($includetype eq 'addon') {
&dump_fields($stmt_mode, *fields, $field_count, '');
}
if ($copied == 1) {
$field_count = 0;
$line = '';
}
$copied;
elsif ( $rec->{type} eq 'addon' )
{
add_to_buffer( 'rules', ' { ' );
}
#add_to_buffer( $stream, $_ );
#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' )
{
dump_fields( $stmt_mode, $fields, '' );
}
# if we added something (ie there are lines in our array), return 1
return 1 if (scalar(@{ $rec->{lines} }) > 0);
return 0;
}
sub add_to_buffer {
local($buffer, $str) = @_;
$buff{$buffer, $buffcnt{$buffer}++} = $str;
# 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
{
push( @{ $buff{$_[0]} }, "$_[1]\n" );
}
sub dump {
local($buffer) = @_;
print '/* ' . $buffer . ' */';
for ($a = 0; $a < $buffcnt{$buffer}; $a++) {
print $buff{$buffer, $a};
}
sub dump_buffer
{
my($buffer) = @_;
print '/* ', $buffer, ' */',"\n";
my $ref = $buff{$buffer};
print @$ref;
}
sub dump_fields {
local($mode, *flds, $len, $ln) = @_;
if ($mode == 0) {
#Normal
&add_to_buffer('rules', $ln);
if ($feature_not_supported == 1) {
# we found an unsupported feature, but we have to
# filter out ExecuteStmt: CREATE OptTemp TABLE ...
# because the warning there is only valid in some situations
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\");");
}
$feature_not_supported = 0;
}
sub dump_fields
{
my ( $mode, $flds, $ln ) = @_;
my $len = scalar(@$flds);
if ( $mode == 0 )
{
#Normal
add_to_buffer( 'rules', $ln );
if ( $feature_not_supported == 1 )
{
# we found an unsupported feature, but we have to
# filter out ExecuteStmt: CREATE OptTemp TABLE ...
# because the warning there is only valid in some situations
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");'
);
}
$feature_not_supported = 0;
}
if ($len == 0) {
# We have no fields ?
&add_to_buffer('rules', " \$\$=EMPTY; }");
if ( $len == 0 )
{
# We have no fields ?
add_to_buffer( 'rules', ' $$=EMPTY; }' );
}
else
{
# Go through each field and try to 'aggregate' the tokens
# into a single 'mm_strdup' where possible
my @flds_new;
my $str;
for ( my $z = 0 ; $z < $len ; $z++ )
{
if ( substr( $flds->[$z], 0, 1 ) eq '$' )
{
push(@flds_new, $flds->[$z]);
next;
}
$str = $flds->[$z];
while (1)
{
if ( $z >= $len - 1 || substr( $flds->[ $z + 1 ], 0, 1 ) eq '$' )
{
# We're at the end...
push(@flds_new, "mm_strdup(\"$str\")");
last;
}
$z++;
$str = $str . ' ' . $flds->[$z];
}
}
# So - how many fields did we end up with ?
$len = scalar(@flds_new);
if ( $len == 1 )
{
# Straight assignement
$str = ' $$ = ' . $flds_new[0] . ';';
add_to_buffer( 'rules', $str );
}
else
{
# Need to concatenate the results to form
# our final string
$str = ' $$ = cat_str(' . $len . ',' . join(',', @flds_new) . ');';
add_to_buffer( 'rules', $str );
}
add_to_buffer( 'rules', '}' );
}
}
else {
# Go through each field and try to 'aggregate' the tokens into a single 'mm_strdup' where possible
$cnt = 0;
for ($z = 0; $z < $len; $z++) {
if (substr($flds{$z}, 1, 1) eq "\$") {
$flds_new{$cnt++} = $flds{$z};
next;
else
{
# we're in the stmt: rule
if ($len)
{
# or just the statement ...
add_to_buffer( 'rules', ' { output_statement($1, 0, ECPGst_normal); }' );
}
else
{
add_to_buffer( 'rules', ' { $$ = NULL; }' );
}
}
}
$str = $flds{$z};
while (1) {
if ($z >= $len - 1 || substr($flds{$z + 1}, 1, 1) eq "\$") {
# We're at the end...
$flds_new{$cnt++} = "mm_strdup(\"" . $str . "\")";
last;
}
$z++;
$str = $str . ' ' . $flds{$z};
sub dump_line
{
my($stmt_mode, $fields) = @_;
my $block = $non_term_id . $line;
$block =~ tr/ |//d;
my $rep = $replace_line{$block};
if ($rep)
{
if ($rep eq 'ignore' )
{
return 0;
}
}
# So - how many fields did we end up with ?
if ($cnt == 1) {
# Straight assignement
$str = " \$\$ = " . $flds_new{0} . ';';
&add_to_buffer('rules', $str);
}
else {
# Need to concatenate the results to form
# our final string
$str = " \$\$ = cat_str(" . $cnt;
for ($z = 0; $z < $cnt; $z++) {
$str = $str . ',' . $flds_new{$z};
if ( index( $line, '|' ) != -1 )
{
$line = '| ' . $rep;
}
$str = $str . ');';
&add_to_buffer('rules', $str);
}
if ($literal_mode == 0) {
&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); }");
else
{
$line = $rep;
}
$block = $non_term_id . $line;
$block =~ tr/ |//d;
}
else {
&add_to_buffer('rules', " { \$\$ = NULL; }");
add_to_buffer( 'rules', $line );
my $i = include_addon( 'rules', $block, $fields, $stmt_mode);
if ( $i == 0 )
{
dump_fields( $stmt_mode, $fields, ' { ' );
}
}
return 1;
}
sub generate_block {
local($line) = @_;
$block = $non_term_id . $line;
$s = ' ', $block =~ s/$s//g;
$s = "\\|", $block =~ s/$s//g;
return $block;
}
=top
load addons into cache
%addons = {
stmtClosePortalStmt => { 'type' => 'block', 'lines' => [ "{", "if (INFORMIX_MODE)" ..., "}" ] },
stmtViewStmt => { 'type' => 'rule', 'lines' => [ "| ECPGAllocateDescr", ... ] }
}
sub dump_line {
local($stmt_mode, $fields, $field_count) = @_;
$block = &generate_block($line);
if ($replace_line{$block} eq 'ignore') {
return 0;
}
elsif ($replace_line{$block}) {
if (index($line, '|') != 0) {
$line = '| ' . $replace_line{$block};
=cut
sub preload_addons
{
my $filename = $path . "/ecpg.addons";
open(my $fh, '<', $filename) or die;
# there may be multple lines starting ECPG: and then multiple lines of code.
# the code need to be add to all prior ECPG records.
my (@needsRules, @code, $record);
# there may be comments before the first ECPG line, skip them
my $skip = 1;
while ( <$fh> )
{
if (/^ECPG:\s(\S+)\s?(\w+)?/)
{
$skip = 0;
if (@code)
{
for my $x (@needsRules)
{
push(@{ $x->{lines} }, @code);
}
@code = ();
@needsRules = ();
}
$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;
push(@code, $_);
}
}
else {
$line = $replace_line{$block};
close($fh);
if (@code)
{
for my $x (@needsRules)
{
push(@{ $x->{lines} }, @code);
}
}
$block = &generate_block($line);
}
&add_to_buffer('rules', $line);
$i = &include_stuff('rules', 'ecpg.addons', $block, 0, $field_count);
if ($i == 0) {
&dump_fields($stmt_mode, *fields, $field_count, ' { ');
}
return 1;
}
sub Getline2 {
&Pick('',@_);
if ($getline_ok = (($_ = <$fh>) ne '')) {
chomp; # strip record separator
@Fld = split(' ', $_, -1);
}
$_;
}
sub Pick {
local($mode,$name,$pipe) = @_;
$fh = $name;
open($name,$mode.$name.$pipe) unless $opened{$name}++;
}
src/interfaces/ecpg/preproc/parse2.pl deleted 100644 → 0
View file @ 2fccc881
#!/usr/bin/perl
# src/interfaces/ecpg/preproc/parse2.pl
# parser generater for ecpg version 2
# call with backend parser as stdin
#
# Copyright (c) 2007-2011, PostgreSQL Global Development Group
#
# Written by Mike Aubury <mike.aubury@aubit.com>
# Michael Meskes <meskes@postgresql.org>
# Andy Colson <andy@squeakycode.net>
#
# Placed under the same license as PostgreSQL.
#
use strict;
use warnings;
no warnings 'uninitialized';
my $path = shift @ARGV;
$path = "." unless $path;
my $copymode = 0;
my $brace_indent = 0;
my $yaccmode = 0;
my $header_included = 0;
my $feature_not_supported = 0;
my $tokenmode = 0;
my(%buff, $infield, $comment, %tokens, %addons );
my($stmt_mode, @fields);
my($line, $non_term_id);
# some token have to be replaced by other symbols
# either in the rule
my %replace_token = (
'BCONST' => 'ecpg_bconst',
'FCONST' => 'ecpg_fconst',
'Sconst' => 'ecpg_sconst',
'IDENT' => 'ecpg_ident',
'PARAM' => 'ecpg_param',
);
# or in the block
my %replace_string = (
'WITH_TIME' => 'with time',
'NULLS_FIRST' => 'nulls first',
'NULLS_LAST' => 'nulls last',
'TYPECAST' => '::',
'DOT_DOT' => '..',
'COLON_EQUALS' => ':=',
);
# specific replace_types for specific non-terminals - never include the ':'
# ECPG-only replace_types are defined in ecpg-replace_types
my %replace_types = (
'PrepareStmt' => '<prep>',
'opt_array_bounds' => '<index>',
# "ignore" means: do not create type and rules for this non-term-id
'stmtblock' => 'ignore',
'stmtmulti' => 'ignore',
'CreateAsStmt' => 'ignore',
'DeallocateStmt' => 'ignore',
'ColId' => 'ignore',
'type_function_name' => 'ignore',
'ColLabel' => '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.
my %replace_line = (
'unreserved_keywordCONNECTION' => 'ignore',
'unreserved_keywordCURRENT_P' => 'ignore',
'unreserved_keywordDAY_P' => 'ignore',
'unreserved_keywordHOUR_P' => 'ignore',
'unreserved_keywordINPUT_P' => 'ignore',
'unreserved_keywordMINUTE_P' => 'ignore',
'unreserved_keywordMONTH_P' => 'ignore',
'unreserved_keywordSECOND_P' => 'ignore',
'unreserved_keywordYEAR_P' => 'ignore',
'col_name_keywordCHAR_P' => 'ignore',
'col_name_keywordINT_P' => 'ignore',
'col_name_keywordVALUES' => 'ignore',
'reserved_keywordTO' => 'ignore',
'reserved_keywordUNION' => 'ignore',
# some other production rules have to be ignored or replaced
'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',
'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',
);
preload_addons();
main();
dump_buffer('header');
dump_buffer('tokens');
dump_buffer('types');
dump_buffer('ecpgtype');
dump_buffer('orig_tokens');
print '%%', "\n";
print 'prog: statements;', "\n";
dump_buffer('rules');
include_file( 'trailer', 'ecpg.trailer' );
dump_buffer('trailer');
sub main
{
line: while (<>)
{
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 (/^%%/) {
$tokenmode = 2;
$copymode = 1;
$yaccmode++;
$infield = 0;
}
my $prec = 0;
# Make sure any braces are split
s/{/ { /g;
s/}/ } /g;
# Any comments are split
s|\/\*| /* |g;
s|\*\/| */ |g;
# Now split the line into individual fields
my @arr = split(' ');
if ( $arr[0] eq '%token' && $tokenmode == 0 )
{
$tokenmode = 1;
include_file( 'tokens', 'ecpg.tokens' );
}
elsif ( $arr[0] eq '%type' && $header_included == 0 )
{
include_file( 'header', 'ecpg.header' );
include_file( 'ecpgtype', 'ecpg.type' );
$header_included = 1;
}
if ( $tokenmode == 1 )
{
my $str = '';
my $prior = '';
for my $a (@arr)
{
if ( $a eq '/*' )
{
$comment++;
next;
}
if ( $a eq '*/' )
{
$comment--;
next;
}
if ($comment)
{
next;
}
if ( substr( $a, 0, 1 ) eq '<' ) {
next;
# its a type
}
$tokens{ $a } = 1;
$str = $str . ' ' . $a;
if ( $a eq 'IDENT' && $prior eq '%nonassoc' )
{
# add two more tokens to the list
$str = $str . "\n%nonassoc CSTRING\n%nonassoc UIDENT";
}
$prior = $a;
}
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 )
{
next line;
}
# Go through each field in turn
for (my $fieldIndexer = 0 ; $fieldIndexer < scalar(@arr) ; $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;
}
elsif ( $arr[$fieldIndexer] eq '}' )
{
$brace_indent--;
next;
}
elsif ( $arr[$fieldIndexer] eq '{' )
{
$brace_indent++;
next;
}
if ( $brace_indent > 0 )
{
next;
}
if ( $arr[$fieldIndexer] eq ';' )
{
if ($copymode)
{
if ( $infield )
{
dump_line( $stmt_mode, \@fields );
}
add_to_buffer( 'rules', ";\n\n" );
}
else
{
$copymode = 1;
}
@fields = ();
$infield = 0;
$line = '';
next;
}
if ( $arr[$fieldIndexer] eq '|' )
{
if ($copymode)
{
if ( $infield )
{
$infield = $infield + dump_line( $stmt_mode, \@fields );
}
if ( $infield > 1 )
{
$line = '| ';
}
}
@fields = ();
next;
}
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 ':' )
{
$non_term_id = $arr[$fieldIndexer];
$non_term_id =~ tr/://d;
if ( not defined $replace_types{$non_term_id} )
{
$replace_types{$non_term_id} = '<str>';
$copymode = 1;
}
elsif ( $replace_types{$non_term_id} eq 'ignore' )
{
$copymode = 0;
$line = '';
next line;
}
$line = $line . ' ' . $arr[$fieldIndexer];
# Do we have the : attached already ?
# If yes, we'll have already printed the ':'
if ( !( $arr[$fieldIndexer] =~ '[A-Za-z0-9]+:' ) )
{
# Consume the ':' which is next...
$line = $line . ':';
$fieldIndexer++;
}
# Special mode?
if ( $non_term_id eq 'stmt' )
{
$stmt_mode = 1;
}
else
{
$stmt_mode = 0;
}
my $tstr = '%type ' . $replace_types{$non_term_id} . ' ' . $non_term_id;
add_to_buffer( 'types', $tstr );
if ($copymode)
{
add_to_buffer( 'rules', $line );
}
$line = '';
@fields = ();
$infield = 1;
next;
}
elsif ($copymode) {
$line = $line . ' ' . $arr[$fieldIndexer];
}
if ( $arr[$fieldIndexer] eq '%prec' )
{
$prec = 1;
next;
}
if ( $copymode
&& !$prec
&& !$comment
&& length( $arr[$fieldIndexer] )
&& $infield )
{
if (
$arr[$fieldIndexer] ne 'Op'
&& ( $tokens{ $arr[$fieldIndexer] } > 0 || $arr[$fieldIndexer] =~ /'.+'/ )
|| $stmt_mode == 1
)
{
my $S;
if ( exists $replace_string{ $arr[$fieldIndexer] } )
{
$S = $replace_string{ $arr[$fieldIndexer] };
}
else
{
$S = $arr[$fieldIndexer];
}
$S =~ s/_P//g;
$S =~ tr/'//d;
if ( $stmt_mode == 1 )
{
push(@fields, $S);
}
else
{
push(@fields, lc($S));
}
}
else
{
push(@fields, '$' . (scalar(@fields)+1));
}
}
}
}
}
# append a file onto a buffer.
# Arguments: buffer_name, filename (without path)
sub include_file
{
my ($buffer, $filename) = @_;
my $full = "$path/$filename";
open(my $fh, '<', $full) or die;
while ( <$fh> )
{
chomp;
add_to_buffer( $buffer, $_ );
}
close($fh);
}
sub include_addon
{
my($buffer, $block, $fields, $stmt_mode) = @_;
my $rec = $addons{$block};
return 0 unless $rec;
if ( $rec->{type} eq 'rule' )
{
dump_fields( $stmt_mode, $fields, ' { ' );
}
elsif ( $rec->{type} eq 'addon' )
{
add_to_buffer( 'rules', ' { ' );
}
#add_to_buffer( $stream, $_ );
#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' )
{
dump_fields( $stmt_mode, $fields, '' );
}
# if we added something (ie there are lines in our array), return 1
return 1 if (scalar(@{ $rec->{lines} }) > 0);
return 0;
}
# 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
{
push( @{ $buff{$_[0]} }, "$_[1]\n" );
}
sub dump_buffer
{
my($buffer) = @_;
print '/* ', $buffer, ' */',"\n";
my $ref = $buff{$buffer};
print @$ref;
}
sub dump_fields
{
my ( $mode, $flds, $ln ) = @_;
my $len = scalar(@$flds);
if ( $mode == 0 )
{
#Normal
add_to_buffer( 'rules', $ln );
if ( $feature_not_supported == 1 )
{
# we found an unsupported feature, but we have to
# filter out ExecuteStmt: CREATE OptTemp TABLE ...
# because the warning there is only valid in some situations
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");'
);
}
$feature_not_supported = 0;
}
if ( $len == 0 )
{
# We have no fields ?
add_to_buffer( 'rules', ' $$=EMPTY; }' );
}
else
{
# Go through each field and try to 'aggregate' the tokens
# into a single 'mm_strdup' where possible
my @flds_new;
my $str;
for ( my $z = 0 ; $z < $len ; $z++ )
{
if ( substr( $flds->[$z], 0, 1 ) eq '$' )
{
push(@flds_new, $flds->[$z]);
next;
}
$str = $flds->[$z];
while (1)
{
if ( $z >= $len - 1 || substr( $flds->[ $z + 1 ], 0, 1 ) eq '$' )
{
# We're at the end...
push(@flds_new, "mm_strdup(\"$str\")");
last;
}
$z++;
$str = $str . ' ' . $flds->[$z];
}
}
# So - how many fields did we end up with ?
$len = scalar(@flds_new);
if ( $len == 1 )
{
# Straight assignement
$str = ' $$ = ' . $flds_new[0] . ';';
add_to_buffer( 'rules', $str );
}
else
{
# Need to concatenate the results to form
# our final string
$str = ' $$ = cat_str(' . $len . ',' . join(',', @flds_new) . ');';
add_to_buffer( 'rules', $str );
}
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); }' );
}
else
{
add_to_buffer( 'rules', ' { $$ = NULL; }' );
}
}
}
sub dump_line
{
my($stmt_mode, $fields) = @_;
my $block = $non_term_id . $line;
$block =~ tr/ |//d;
my $rep = $replace_line{$block};
if ($rep)
{
if ($rep eq 'ignore' )
{
return 0;
}
if ( index( $line, '|' ) != -1 )
{
$line = '| ' . $rep;
}
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 )
{
dump_fields( $stmt_mode, $fields, ' { ' );
}
return 1;
}
=top
load addons into cache
%addons = {
stmtClosePortalStmt => { 'type' => 'block', 'lines' => [ "{", "if (INFORMIX_MODE)" ..., "}" ] },
stmtViewStmt => { 'type' => 'rule', 'lines' => [ "| ECPGAllocateDescr", ... ] }
}
=cut
sub preload_addons
{
my $filename = $path . "/ecpg.addons";
open(my $fh, '<', $filename) or die;
# there may be multple lines starting ECPG: and then multiple lines of code.
# the code need to be add to all prior ECPG records.
my (@needsRules, @code, $record);
# there may be comments before the first ECPG line, skip them
my $skip = 1;
while ( <$fh> )
{
if (/^ECPG:\s(\S+)\s?(\w+)?/)
{
$skip = 0;
if (@code)
{
for my $x (@needsRules)
{
push(@{ $x->{lines} }, @code);
}
@code = ();
@needsRules = ();
}
$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;
push(@code, $_);
}
}
close($fh);
if (@code)
{
for my $x (@needsRules)
{
push(@{ $x->{lines} }, @code);
}
}
}
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