view release on metacpan or  search on metacpan

lib/Genezzo/Parse/SQLGrammar.pl  view on Meta::CPAN

# XXX XXX: need some sort of storage clause before ctas
   create_table_def: table_constraint_def(?) 
                     table_element_list(?) 
                     storage_clause(?)
                     ct_as_select(?)
{ $return = {tab_column_list  => $item{'table_element_list(?)'},
             table_query      => $item{'ct_as_select(?)'},
             table_constraint => $item{'table_constraint_def(?)'},
             storage_clause   => $item{'storage_clause(?)'}
         }
}

storage_clause: /TABLESPACE/i  identifier
{ $return = { 
              store_op        => "TABLESPACE",    
              tablespace_name => [$item{identifier}] }}

table_element_list: '(' <commit> table_elt(s /,/) ')'                    
# skip parens
# lparen is 1, commit is 2, column list is 3
# cannot use item{table_elt} because it repeats...    
{ my @foo = @{$item[3]}; $return = \@foo; }
                       | <error: invalid column list>

# column definition or table_constraint 
# column type is optional for create table as select
        table_elt : column_name column_type(?) 
                    column_default(?) col_cons_list(?)
{$return = {new_column_name => $item{column_name},
            column_type     => $item{'column_type(?)'},
            column_default  => $item{'column_default(?)'},
            col_cons_list   => $item{'col_cons_list(?)'}}}
                  | table_constraint_def
{$return = {table_constraint => $item{table_constraint_def}}}

   column_default : DEFAULT value_expression
{$return = $item{value_expression}}

   col_cons_list  : column_constraint_def(s)
{$return = $item[1]}

# XXX XXX: need constraint attibutes - deferrable, DISABLE etc
column_constraint_def: constraint_name(?) col_cons
{$return = {name => $item{'constraint_name(?)'},
            constraint => $item{col_cons}
        }
}
 table_constraint_def: constraint_name(?) table_cons
{$return = {name => $item{'constraint_name(?)'},
            constraint => $item{table_cons}
        }
}

# use to disambiguate column list for FOREIGN KEY and list for REFERENCES
 fkref_column_list: column_list
{$return = $item[1]}

  constraint_name : CONSTRAINT_ big_id
{$return = $item{big_id}}

# XXX XXX: references on delete cascade - referential action
     col_cons     : NOT(?) NULL
{$return = {operator => $item[2],
            cons_type => 'nullable',
            operands => $item{'NOT(?)'}            
            }}
                  | UNIQUE
{$return = {operator => $item[1],
            cons_type => 'unique'
            }}
                  | PRIMARY KEY
{$return = {operator => $item[1],
            cons_type => 'primary_key'
            }}
                  | REFERENCES_ big_id fkref_column_list
{$return = {operator => $item[1],
            cons_type => 'foreign_key',
            operands => 
            {
                table       => $item{big_id},
                keycols     => $item{fkref_column_list}
            }
        }
}
                  | sqCHECK_ '(' search_cond ')'
{
#
# get start/stop position for search condition
#
    my $p1 = $itempos[3]{offset}{from};
    my $p2 = $itempos[3]{offset}{to};
    $return = {operator => $item[1],
               cons_type => 'check',
               operands => {
                   p1 => $p1,
                   p2 => $p2,
                   sc_tree => $item{search_cond}
               }
           };
}

   table_cons     : UNIQUE column_list 
{$return = {operator => $item[1],
            cons_type => 'unique',
            operands => $item{column_list}, # XXX XXX XXX: cleanup
            column_list => $item{column_list}
        }
}
                  | PRIMARY KEY column_list
{$return = {operator => $item[1],
            cons_type => 'primary_key',
            operands => $item{column_list}, # XXX XXX XXX: cleanup
            column_list => $item{column_list}
        }
}
                  | FOREIGN KEY column_list 
                    REFERENCES_ big_id fkref_column_list
{$return = {operator => $item[1],
            cons_type => 'foreign_key',
            operands => 
            {

lib/Genezzo/Parse/SQLGrammar.pl  view on Meta::CPAN

# # The argument is a string which contains a SQL query
# # (without a trailing semicolon).
# # The output is nested hash structure of the abstract 
# # syntax tree.
# my $sql_tree = $parser->sql_000($some_sql_statement);
#
# # dump out the parse tree
# print Data::Dumper->Dumper([$sql_tree],['sql_tree']);
#
#
#=head1 DESCRIPTION
#
#  The SQL parser is a L<Parse::RecDescent> parser generated by 
#  L<Genezzo::Parse::SQLGrammar>.  It shouldn't be looked at with
#  human eyes.  
#
#  Still reading this?  You must be a glutton for punishment.
#
#  This parser handles a fair bit of SQL92, but the error handling
#  is somewhat lacking.
#
#=head1 ARGUMENTS
#
#=head1 FUNCTIONS
#
#
#=head2 EXPORT
#
#=over 4
#
#
#=back
#
#
#=head1 LIMITATIONS
#
# No support for DDL, ANSI Interval, Date, Timestamp, etc.
#
#=head1 TODO
#
#=over 4
#
#=item  alter table (elcaro MODIFY column NOT NULL) vs (sql3 ALTER COLUMN)...
#
#=item  Support for DDL, ANSI Interval, Date, Timestamp, etc.
#
#=item  fix the extra array deref in join rules
#
#=item  error messages everywhere
#
#=item ECOUNT reserved word issues
#
#=item TRIM, UPPER, etc in standard function list?
#
#=item use of negative lookahead in reserved_word regex?
#
#=item table constraint, storage clause
#
#=item constraint attributes - deferrable, disable
#
#=item delete cascade referential action
#
#=item maybe can collapse qualified join with qj_leftop?
#
#=item table expr optional column list
#
#=item "system" literals like USER, SYSDATE
#
#=item better separation of strings and numbers (see concatenate)
#
#=item leading NOT
#
#=item double colon in function names?
#
#
#=back
#
#=head1 AUTHOR
#
#Jeffrey I. Cohen, jcohen@genezzo.com
#
#=head1 SEE ALSO
#
#L<perl(1)>.
#
#Copyright (c) 2005,2006 Jeffrey I Cohen.  All rights reserved.
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
#
#Address bug reports and comments to: jcohen@genezzo.com
#
#For more information, please visit the Genezzo homepage 
#at L<http://www.genezzo.com>
#
#=cut
#
END_OF_MSG

    #
    my $now_string = localtime();
    $msg .= "\n# Generated by SQLGrammar.pl on $now_string\n\n";
    my $fh;
    open($fh, ">> SQL.pm")
        or die "could not open SQL.pm for write : $! \n";
    print $fh $msg;
    close $fh;

}