SQL-Translator-0.11018/ 0000755 0001750 0001750 00000000000 12234461403 013141 5 ustar frew frew SQL-Translator-0.11018/xt/ 0000755 0001750 0001750 00000000000 12234461403 013574 5 ustar frew frew SQL-Translator-0.11018/xt/pod.t 0000644 0001750 0001750 00000000163 12143357341 014547 0 ustar frew frew use Test::More;
eval "use Test::Pod 1.14";
plan skip_all => 'Test::Pod 1.14 required' if $@;
all_pod_files_ok();
SQL-Translator-0.11018/xt/eol.t 0000644 0001750 0001750 00000000542 12143357341 014545 0 ustar frew frew use warnings;
use strict;
use Test::More;
eval "use Test::EOL 1.1";
plan skip_all => 'Test::EOL 1.1 required' if $@;
Test::EOL::all_perl_files_ok({ trailing_whitespace => 1},
qw|lib t xt script share/DiaUml|,
);
# FIXME - Test::EOL declares 'no_plan' which conflicts with done_testing
# https://github.com/schwern/test-more/issues/14
#done_testing;
SQL-Translator-0.11018/xt/notabs.t 0000644 0001750 0001750 00000000523 12143357341 015253 0 ustar frew frew use warnings;
use strict;
use Test::More;
eval "use Test::NoTabs 1.1";
plan skip_all => 'Test::NoTabs 1.1 required' if $@;
Test::NoTabs::all_perl_files_ok(
qw|lib t xt script share/DiaUml|,
);
# FIXME - Test::NoTabs declares 'no_plan' which conflicts with done_testing
# https://github.com/schwern/test-more/issues/14
#done_testing;
SQL-Translator-0.11018/share/ 0000755 0001750 0001750 00000000000 12234461403 014243 5 ustar frew frew SQL-Translator-0.11018/share/DiaUml/ 0000755 0001750 0001750 00000000000 12234461403 015416 5 ustar frew frew SQL-Translator-0.11018/share/DiaUml/uml-class.tt2 0000644 0001750 0001750 00000000651 12143357340 017756 0 ustar frew frew [%# vim:ft=tt2
-%]
[% INCLUDE 'uml-class-start.tt2' %]
[%- FOREACH attributes;
INCLUDE "uml-attribute.tt2";
END %]
[% INCLUDE 'uml-class-end.tt2' %]
SQL-Translator-0.11018/share/DiaUml/layer.tt2 0000644 0001750 0001750 00000000210 12143357340 017161 0 ustar frew frew [%-
DEFAULT name="Layer1" visible="true"
%]
[% content %]
SQL-Translator-0.11018/share/DiaUml/schema.tt2 0000644 0001750 0001750 00000002144 12143357340 017315 0 ustar frew frew [%# vim:ft=tt2 -%]
[% WRAPPER diagram.tt2 %]
[% WRAPPER layer.tt2 name="Background" %]
[% FOREACH table IN schema.get_tables %]
[% INCLUDE 'uml-class-start.tt2'
name = table.name
stereotype = 'Table'
visible_operations = 'false'
%]
[% FOREACH field IN table.get_fields;
SET type = field.data_type;
SET type = "$type($field.size)" IF field.size;
INCLUDE "uml-attribute.tt2"
name = field.name
stereotype = 'Field'
type = type
value = field.default_value
;
END %]
[% INCLUDE 'uml-class-end.tt2' %]
[% END %]
[% END %]
[% END %]
SQL-Translator-0.11018/share/DiaUml/uml-class-all.tt2 0000644 0001750 0001750 00000007375 12143357340 020536 0 ustar frew frew [%# vim:ft=tt2
-%]
#[% name %]#
#[% stereotype %]#
#[% comment %]#
[% FOREACH attributes %]
[% INCLUDE "uml-attribute.tt2" %]
[% END %]
SQL-Translator-0.11018/share/DiaUml/uml-class-end.tt2 0000644 0001750 0001750 00000000045 12143357340 020517 0 ustar frew frew [%# vim:ft=tt2
-%]
SQL-Translator-0.11018/share/DiaUml/uml-class-start.tt2 0000644 0001750 0001750 00000006736 12143357340 021123 0 ustar frew frew [% # vim:ft=tt2
DEFAULT
visible_operations='true'
-%]
#[% name %]#
#[% stereotype %]#
#[% comment %]#
SQL-Translator-0.11018/share/DiaUml/uml-attribute.tt2 0000644 0001750 0001750 00000001727 12143357340 020661 0 ustar frew frew [%# vim:ft=tt2
-%]
[%-
DEFAULT visibility=0 abstract="false" class_scope="false"
%]
#[% name %]#
#[% type %]#
#[% value %]#
#[% comment %]#
SQL-Translator-0.11018/share/DiaUml/diagram.tt2 0000644 0001750 0001750 00000004110 12143357340 017454 0 ustar frew frew
#A4#
[% content %]
SQL-Translator-0.11018/share/PrecompiledParsers/ 0000755 0001750 0001750 00000000000 12234461403 020046 5 ustar frew frew SQL-Translator-0.11018/share/PrecompiledParsers/Parse/ 0000755 0001750 0001750 00000000000 12234461403 021120 5 ustar frew frew SQL-Translator-0.11018/share/PrecompiledParsers/Parse/RecDescent/ 0000755 0001750 0001750 00000000000 12234461403 023137 5 ustar frew frew SQL-Translator-0.11018/share/PrecompiledParsers/Parse/RecDescent/DDL/ 0000755 0001750 0001750 00000000000 12234461403 023542 5 ustar frew frew SQL-Translator-0.11018/share/PrecompiledParsers/Parse/RecDescent/DDL/SQLT/ 0000755 0001750 0001750 00000000000 12234461403 024325 5 ustar frew frew SQL-Translator-0.11018/share/PrecompiledParsers/Parse/RecDescent/DDL/SQLT/README 0000644 0001750 0001750 00000000147 12143357340 025212 0 ustar frew frew The contents of this directory are automatically regenerated when
invoking Makefile.PL in author mode.
SQL-Translator-0.11018/MANIFEST 0000644 0001750 0001750 00000014334 12234461315 014301 0 ustar frew frew Changes
inc/Module/AutoInstall.pm
inc/Module/Install.pm
inc/Module/Install/AuthorTests.pm
inc/Module/Install/AutoInstall.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
inc/Module/Install/Fetch.pm
inc/Module/Install/Include.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/ReadmeFromPod.pm
inc/Module/Install/Scripts.pm
inc/Module/Install/Share.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/SQL/Translator.pm
lib/SQL/Translator/Diff.pm
lib/SQL/Translator/Filter/DefaultExtra.pm
lib/SQL/Translator/Filter/Globals.pm
lib/SQL/Translator/Filter/Names.pm
lib/SQL/Translator/Generator/DDL/PostgreSQL.pm
lib/SQL/Translator/Generator/DDL/SQLite.pm
lib/SQL/Translator/Generator/DDL/SQLServer.pm
lib/SQL/Translator/Generator/Role/DDL.pm
lib/SQL/Translator/Generator/Role/Quote.pm
lib/SQL/Translator/Manual.pod
lib/SQL/Translator/Parser.pm
lib/SQL/Translator/Parser/Access.pm
lib/SQL/Translator/Parser/DB2.pm
lib/SQL/Translator/Parser/DB2/Grammar.pm
lib/SQL/Translator/Parser/DBI.pm
lib/SQL/Translator/Parser/DBI/DB2.pm
lib/SQL/Translator/Parser/DBI/MySQL.pm
lib/SQL/Translator/Parser/DBI/Oracle.pm
lib/SQL/Translator/Parser/DBI/PostgreSQL.pm
lib/SQL/Translator/Parser/DBI/SQLite.pm
lib/SQL/Translator/Parser/DBI/SQLServer.pm
lib/SQL/Translator/Parser/DBI/Sybase.pm
lib/SQL/Translator/Parser/Excel.pm
lib/SQL/Translator/Parser/JSON.pm
lib/SQL/Translator/Parser/MySQL.pm
lib/SQL/Translator/Parser/Oracle.pm
lib/SQL/Translator/Parser/PostgreSQL.pm
lib/SQL/Translator/Parser/SQLite.pm
lib/SQL/Translator/Parser/SQLServer.pm
lib/SQL/Translator/Parser/Storable.pm
lib/SQL/Translator/Parser/Sybase.pm
lib/SQL/Translator/Parser/XML.pm
lib/SQL/Translator/Parser/XML/SQLFairy.pm
lib/SQL/Translator/Parser/xSV.pm
lib/SQL/Translator/Parser/YAML.pm
lib/SQL/Translator/Producer.pm
lib/SQL/Translator/Producer/ClassDBI.pm
lib/SQL/Translator/Producer/DB2.pm
lib/SQL/Translator/Producer/Diagram.pm
lib/SQL/Translator/Producer/DiaUml.pm
lib/SQL/Translator/Producer/Dumper.pm
lib/SQL/Translator/Producer/GraphViz.pm
lib/SQL/Translator/Producer/HTML.pm
lib/SQL/Translator/Producer/JSON.pm
lib/SQL/Translator/Producer/Latex.pm
lib/SQL/Translator/Producer/MySQL.pm
lib/SQL/Translator/Producer/Oracle.pm
lib/SQL/Translator/Producer/POD.pm
lib/SQL/Translator/Producer/PostgreSQL.pm
lib/SQL/Translator/Producer/SQLite.pm
lib/SQL/Translator/Producer/SQLServer.pm
lib/SQL/Translator/Producer/Storable.pm
lib/SQL/Translator/Producer/Sybase.pm
lib/SQL/Translator/Producer/TT/Base.pm
lib/SQL/Translator/Producer/TT/Table.pm
lib/SQL/Translator/Producer/TTSchema.pm
lib/SQL/Translator/Producer/XML.pm
lib/SQL/Translator/Producer/XML/SQLFairy.pm
lib/SQL/Translator/Producer/YAML.pm
lib/SQL/Translator/Role/BuildArgs.pm
lib/SQL/Translator/Role/Debug.pm
lib/SQL/Translator/Role/Error.pm
lib/SQL/Translator/Role/ListAttr.pm
lib/SQL/Translator/Schema.pm
lib/SQL/Translator/Schema/Constants.pm
lib/SQL/Translator/Schema/Constraint.pm
lib/SQL/Translator/Schema/Field.pm
lib/SQL/Translator/Schema/Index.pm
lib/SQL/Translator/Schema/Object.pm
lib/SQL/Translator/Schema/Procedure.pm
lib/SQL/Translator/Schema/Role/Compare.pm
lib/SQL/Translator/Schema/Role/Extra.pm
lib/SQL/Translator/Schema/Table.pm
lib/SQL/Translator/Schema/Trigger.pm
lib/SQL/Translator/Schema/View.pm
lib/SQL/Translator/Types.pm
lib/SQL/Translator/Utils.pm
lib/Test/SQL/Translator.pm
Makefile.PL
MANIFEST This list of files
META.yml
README
script/sqlt
script/sqlt-diagram
script/sqlt-diff
script/sqlt-diff-old
script/sqlt-dumper
script/sqlt-graph
script/sqlt.cgi
share/DiaUml/diagram.tt2
share/DiaUml/layer.tt2
share/DiaUml/schema.tt2
share/DiaUml/uml-attribute.tt2
share/DiaUml/uml-class-all.tt2
share/DiaUml/uml-class-end.tt2
share/DiaUml/uml-class-start.tt2
share/DiaUml/uml-class.tt2
share/PrecompiledParsers/Parse/RecDescent/DDL/SQLT/README
t/02mysql-parser.t
t/03mysql-to-oracle.t
t/04file,fh,string.t
t/05bgep-re.t
t/06xsv.t
t/07p_args.t
t/08postgres-to-mysql.t
t/09sqlt-diagram.t
t/10excel.t
t/11normalize.t
t/12header_comment.t
t/13schema.t
t/14postgres-parser.t
t/15oracle-parser.t
t/16xml-parser.t
t/17sqlfxml-producer.t
t/18ttschema-producer.t
t/19sybase-parser.t
t/20format_X_name.t
t/23json.t
t/24yaml.t
t/25storable.t
t/26sybase.t
t/27sqlite-parser.t
t/29html.t
t/30sqlt-new-diff-mysql.t
t/30sqlt-new-diff-pgsql.t
t/30sqlt-new-diff-sqlite.t
t/30sqlt-new-diff.t
t/31dumper.t
t/32schema-lookups.t
t/33tt-table-producer.t
t/34tt-base.t
t/35-access-parser.t
t/36-filters.t
t/38-filter-names.t
t/38-mysql-producer.t
t/39-filter-globals.t
t/40oracle-parser-dbi.t
t/43xml-to-db2.t
t/44-xml-to-db2-array.t
t/45db2-producer.t
t/46xml-to-pg.t
t/47postgres-producer.t
t/48xml-to-sqlite.t
t/49xml-to-pg-samefield.t
t/50-sqlserver-parser.t
t/51-xml-to-oracle.t
t/51-xml-to-oracle_quoted.t
t/52-oracle-options.t
t/53-oracle-delay-constraints.t
t/53-oracle-delay-constraints_quoted.t
t/54-oracle-alter-field.t
t/55-oracle-add-field.t
t/55-oracle-producer.t
t/56-sqlite-producer.t
t/57-class-dbi.t
t/60roundtrip.t
t/61translator_agnostic.t
t/62roundtrip_datacheck.t
t/63-spacial-pgsql.t
t/64xml-to-mysql.t
t/66-postgres-dbi-parser.t
t/70sqlt-diff_script.t
t/70sqlt-diff_script_old.t
t/71-generator-sql_server.t
t/72-sqlite-add-drop-fields.t
t/73-sqlite-respects-quote.t
t/74-filename-arrayref.t
t/data/access/gdpdm.ddl
t/data/diff/create1.yml
t/data/diff/create2.yml
t/data/diff/pgsql/create1.yml
t/data/diff/pgsql/create2.yml
t/data/Excel/t.xls
t/data/mysql/Apache-Session-MySQL.sql
t/data/mysql/BGEP-RE-create.sql
t/data/mysql/cashmusic_db.sql
t/data/mysql/create.sql
t/data/mysql/create2.sql
t/data/mysql/entire_syntax.sql
t/data/mysql/sqlfxml-producer-basic.sql
t/data/oracle/create.sql
t/data/oracle/create2.sql
t/data/oracle/schema_diff_a.yaml
t/data/oracle/schema_diff_b.yaml
t/data/oracle/schema_diff_c.yaml
t/data/oracle/schema_with_options.yaml
t/data/pgsql/Chado-CV-PostGreSQL.sql
t/data/pgsql/entire_syntax.sql
t/data/pgsql/turnkey.sql
t/data/roundtrip.xml
t/data/roundtrip_autogen.yaml
t/data/sqlite/create.sql
t/data/sqlite/create2.sql
t/data/sqlite/named.sql
t/data/sqlserver/create.sql
t/data/sybase/create.sql
t/data/template/basic.tt
t/data/template/table.tt
t/data/template/testresult_basic.txt
t/data/template/testresult_table.txt
t/data/xml/samefield.xml
t/data/xml/schema.xml
t/lib/Producer/BaseTest.pm
t/mysql-sqlite-translate.t
xt/eol.t
xt/notabs.t
xt/pod.t
SQL-Translator-0.11018/README 0000644 0001750 0001750 00000032252 12234461166 014033 0 ustar frew frew NAME
SQL::Translator - manipulate structured data definitions (SQL and more)
SYNOPSIS
use SQL::Translator;
my $translator = SQL::Translator->new(
# Print debug info
debug => 1,
# Print Parse::RecDescent trace
trace => 0,
# Don't include comments in output
no_comments => 0,
# Print name mutations, conflicts
show_warnings => 0,
# Add "drop table" statements
add_drop_table => 1,
# to quote or not to quote, thats the question
quote_identifiers => 1,
# Validate schema object
validate => 1,
# Make all table names CAPS in producers which support this option
format_table_name => sub {my $tablename = shift; return uc($tablename)},
# Null-op formatting, only here for documentation's sake
format_package_name => sub {return shift},
format_fk_name => sub {return shift},
format_pk_name => sub {return shift},
);
my $output = $translator->translate(
from => 'MySQL',
to => 'Oracle',
# Or an arrayref of filenames, i.e. [ $file1, $file2, $file3 ]
filename => $file,
) or die $translator->error;
print $output;
DESCRIPTION
This documentation covers the API for SQL::Translator. For a more
general discussion of how to use the modules and scripts, please see
SQL::Translator::Manual.
SQL::Translator is a group of Perl modules that converts vendor-specific
SQL table definitions into other formats, such as other vendor-specific
SQL, ER diagrams, documentation (POD and HTML), XML, and Class::DBI
classes. The main focus of SQL::Translator is SQL, but parsers exist for
other structured data formats, including Excel spreadsheets and
arbitrarily delimited text files. Through the separation of the code
into parsers and producers with an object model in between, it's
possible to combine any parser with any producer, to plug in custom
parsers or producers, or to manipulate the parsed data via the built-in
object model. Presently only the definition parts of SQL are handled
(CREATE, ALTER), not the manipulation of data (INSERT, UPDATE, DELETE).
CONSTRUCTOR
The constructor is called "new", and accepts a optional hash of options.
Valid options are:
* parser / from
* parser_args
* producer / to
* producer_args
* filters
* filename / file
* data
* debug
* add_drop_table
* quote_identifiers
* quote_table_names (DEPRECATED)
* quote_field_names (DEPRECATED)
* no_comments
* trace
* validate
All options are, well, optional; these attributes can be set via
instance methods. Internally, they are; no (non-syntactical) advantage
is gained by passing options to the constructor.
METHODS
add_drop_table
Toggles whether or not to add "DROP TABLE" statements just before the
create definitions.
quote_identifiers
Toggles whether or not to quote identifiers (table, column, constraint,
etc.) with a quoting mechanism suitable for the chosen Producer. The
default (true) is to quote them.
quote_table_names
DEPRECATED - A legacy proxy to "quote_identifiers"
quote_field_names
DEPRECATED - A legacy proxy to "quote_identifiers"
no_comments
Toggles whether to print comments in the output. Accepts a true or false
value, returns the current value.
producer
The "producer" method is an accessor/mutator, used to retrieve or define
what subroutine is called to produce the output. A subroutine defined as
a producer will be invoked as a function (*not a method*) and passed its
container "SQL::Translator" instance, which it should call the "schema"
method on, to get the "SQL::Translator::Schema" generated by the parser.
It is expected that the function transform the schema structure to a
string. The "SQL::Translator" instance is also useful for informational
purposes; for example, the type of the parser can be retrieved using the
"parser_type" method, and the "error" and "debug" methods can be called
when needed.
When defining a producer, one of several things can be passed in: A
module name (e.g., "My::Groovy::Producer"), a module name relative to
the "SQL::Translator::Producer" namespace (e.g., "MySQL"), a module name
and function combination ("My::Groovy::Producer::transmogrify"), or a
reference to an anonymous subroutine. If a full module name is passed in
(for the purposes of this method, a string containing "::" is considered
to be a module name), it is treated as a package, and a function called
"produce" will be invoked: $modulename::produce. If $modulename cannot
be loaded, the final portion is stripped off and treated as a function.
In other words, if there is no file named
My/Groovy/Producer/transmogrify.pm, "SQL::Translator" will attempt to
load My/Groovy/Producer.pm and use "transmogrify" as the name of the
function, instead of the default "produce".
my $tr = SQL::Translator->new;
# This will invoke My::Groovy::Producer::produce($tr, $data)
$tr->producer("My::Groovy::Producer");
# This will invoke SQL::Translator::Producer::Sybase::produce($tr, $data)
$tr->producer("Sybase");
# This will invoke My::Groovy::Producer::transmogrify($tr, $data),
# assuming that My::Groovy::Producer::transmogrify is not a module
# on disk.
$tr->producer("My::Groovy::Producer::transmogrify");
# This will invoke the referenced subroutine directly, as
# $subref->($tr, $data);
$tr->producer(\&my_producer);
There is also a method named "producer_type", which is a string
containing the classname to which the above "produce" function belongs.
In the case of anonymous subroutines, this method returns the string
"CODE".
Finally, there is a method named "producer_args", which is both an
accessor and a mutator. Arbitrary data may be stored in name => value
pairs for the producer subroutine to access:
sub My::Random::producer {
my ($tr, $data) = @_;
my $pr_args = $tr->producer_args();
# $pr_args is a hashref.
Extra data passed to the "producer" method is passed to "producer_args":
$tr->producer("xSV", delimiter => ',\s*');
# In SQL::Translator::Producer::xSV:
my $args = $tr->producer_args;
my $delimiter = $args->{'delimiter'}; # value is ,\s*
parser
The "parser" method defines or retrieves a subroutine that will be
called to perform the parsing. The basic idea is the same as that of
"producer" (see above), except the default subroutine name is "parse",
and will be invoked as "$module_name::parse($tr, $data)". Also, the
parser subroutine will be passed a string containing the entirety of the
data to be parsed.
# Invokes SQL::Translator::Parser::MySQL::parse()
$tr->parser("MySQL");
# Invokes My::Groovy::Parser::parse()
$tr->parser("My::Groovy::Parser");
# Invoke an anonymous subroutine directly
$tr->parser(sub {
my $dumper = Data::Dumper->new([ $_[1] ], [ "SQL" ]);
$dumper->Purity(1)->Terse(1)->Deepcopy(1);
return $dumper->Dump;
});
There is also "parser_type" and "parser_args", which perform analogously
to "producer_type" and "producer_args"
filters
Set or retrieve the filters to run over the schema during the
translation, before the producer creates its output. Filters are sub
routines called, in order, with the schema object to filter as the 1st
arg and a hash of options (passed as a list) for the rest of the args.
They are free to do whatever they want to the schema object, which will
be handed to any following filters, then used by the producer.
Filters are set as an array, which gives the order they run in. Like
parsers and producers, they can be defined by a module name, a module
name relative to the SQL::Translator::Filter namespace, a module name
and function name together or a reference to an anonymous subroutine.
When using a module name a function called "filter" will be invoked in
that package to do the work.
To pass args to the filter set it as an array ref with the 1st value
giving the filter (name or sub) and the rest its args. e.g.
$tr->filters(
sub {
my $schema = shift;
# Do stuff to schema here!
},
DropFKeys,
[ "Names", table => 'lc' ],
[ "Foo", foo => "bar", hello => "world" ],
[ "Filter5" ],
);
Although you normally set them in the constructor, which calls through
to filters. i.e.
my $translator = SQL::Translator->new(
...
filters => [
sub { ... },
[ "Names", table => 'lc' ],
],
...
);
See t/36-filters.t for more examples.
Multiple set calls to filters are cumulative with new filters added to
the end of the current list.
Returns the filters as a list of array refs, the 1st value being a
reference to the filter sub and the rest its args.
show_warnings
Toggles whether to print warnings of name conflicts, identifier
mutations, etc. Probably only generated by producers to let the user
know when something won't translate very smoothly (e.g., MySQL "enum"
fields into Oracle). Accepts a true or false value, returns the current
value.
translate
The "translate" method calls the subroutine referenced by the "parser"
data member, then calls any "filters" and finally calls the "producer"
sub routine (these members are described above). It accepts as arguments
a number of things, in key => value format, including (potentially) a
parser and a producer (they are passed directly to the "parser" and
"producer" methods).
Here is how the parameter list to "translate" is parsed:
* 1 argument means it's the data to be parsed; which could be a string
(filename) or a reference to a scalar (a string stored in memory),
or a reference to a hash, which is parsed as being more than one
argument (see next section).
# Parse the file /path/to/datafile
my $output = $tr->translate("/path/to/datafile");
# Parse the data contained in the string $data
my $output = $tr->translate(\$data);
* More than 1 argument means its a hash of things, and it might be
setting a parser, producer, or datasource (this key is named
"filename" or "file" if it's a file, or "data" for a SCALAR
reference.
# As above, parse /path/to/datafile, but with different producers
for my $prod ("MySQL", "XML", "Sybase") {
print $tr->translate(
producer => $prod,
filename => "/path/to/datafile",
);
}
# The filename hash key could also be:
datasource => \$data,
You get the idea.
filename, data
Using the "filename" method, the filename of the data to be parsed can
be set. This method can be used in conjunction with the "data" method,
below. If both the "filename" and "data" methods are invoked as
mutators, the data set in the "data" method is used.
$tr->filename("/my/data/files/create.sql");
or:
my $create_script = do {
local $/;
open CREATE, "/my/data/files/create.sql" or die $!;
;
};
$tr->data(\$create_script);
"filename" takes a string, which is interpreted as a filename. "data"
takes a reference to a string, which is used as the data to be parsed.
If a filename is set, then that file is opened and read when the
"translate" method is called, as long as the data instance variable is
not set.
schema
Returns the SQL::Translator::Schema object.
trace
Turns on/off the tracing option of Parse::RecDescent.
validate
Whether or not to validate the schema object after parsing and before
producing.
version
Returns the version of the SQL::Translator release.
AUTHORS
See the included AUTHORS file:
If you would like to contribute to the project, you can send patches to
the developers mailing list:
sqlfairy-developers@lists.sourceforge.net
Or send us a message (with your Sourceforge username) asking to be added
to the project and what you'd like to contribute.
COPYRIGHT
Copyright 2012 the SQL::Translator authors, as listed in "AUTHORS".
LICENSE
This library is free software and may be distributed under the same
terms as Perl 5 itself.
BUGS
Please use for reporting bugs.
PRAISE
If you find this module useful, please use
to rate
it.
SEE ALSO
perl, SQL::Translator::Parser, SQL::Translator::Producer,
Parse::RecDescent, GD, GraphViz, Text::RecordParser, Class::DBI,
XML::Writer.
SQL-Translator-0.11018/lib/ 0000755 0001750 0001750 00000000000 12234461403 013707 5 ustar frew frew SQL-Translator-0.11018/lib/SQL/ 0000755 0001750 0001750 00000000000 12234461403 014346 5 ustar frew frew SQL-Translator-0.11018/lib/SQL/Translator/ 0000755 0001750 0001750 00000000000 12234461403 016477 5 ustar frew frew SQL-Translator-0.11018/lib/SQL/Translator/Manual.pod 0000644 0001750 0001750 00000045476 12234455220 020440 0 ustar frew frew =head1 NAME
SQL::Translator::Manual - sqlfairy user manual
=head1 SYNOPSIS
SQL::Translator (AKA "SQLFairy") is a collection of modules for
transforming (mainly) SQL DDL files into a variety of other formats,
including other SQL dialects, documentation, images, and code. In
this manual, we will attempt to address how to use SQLFairy for common
tasks. For a lower-level discussion of how the code works, please
read the documentation for L.
It may prove helpful to have a general understanding of the SQLFairy
code before continuing. The code can be broken into three conceptual
groupings:
=over 4
=item * Parsers
The parsers are responsible for reading the input files and describing
them to the Schema object middleware.
=item * Producers
The producers create the output as described by the Schema middleware.
=item * Schema objects
The Schema objects bridge the communication between the Parsers and
Producers by representing any parsed file through a standard set of
generic objects to represent concepts like Tables, Fields (columns),
Indices, Constraints, etc.
=back
It's not necessary to understand how to write or manipulate any
of these for most common tasks, but you should aware of the concepts
as they will be referenced later in this document.
=head1 SQLFAIRY SCRIPTS
Most common tasks can be accomplished through the use of the script
interfaces to the SQL::Translator code. All SQLFairy scripts begin
with "sqlt." Here are the scripts and a description of what they each
do:
=over 4
=item * sqlt
This is the main interface for text-to-text translations, e.g.,
converting a MySQL schema to Oracle.
=item * sqlt-diagram
This is a tailored interface for the Diagram producer and its many
myriad options.
=item * sqlt-diff
This script will examine two schemas and report the SQL commands
(ALTER, CREATE) needed to turn the first schema into the second.
=item * sqlt-dumper
This script generates a Perl script that can be used to connect to a
database and dump the data in each table in different formats, similar
to the "mysqldump" program.
=item * sqlt-graph
This is an interface to the GraphViz visualization tool and its myriad
options.
=item * sqlt.cgi
This is a CGI script that presents an HTML form for uploading or
pasting a schema and choosing an output and the output options.
=back
To read the full documentation for each script, use "perldoc" (or
execute any of the command-line scripts with the "--help" flag).
=head1 CONVERTING SQL DIALECTS
Probably the most common task SQLFairy is used for is to convert one
dialect of SQL to another. If you have a text description of an SQL
database (AKA a "DDL" -- "Data Definition Language"), then you should
use the "sqlt" script with switches to indicate the parser and
producer and the name of the text file as the final argument. For
example, to convert the "foo.sql" MySQL schema to a version suitable
for PostgreSQL, you would do the following:
$ sqlt -f MySQL -t PostgreSQL foo.sql > foo-pg.sql
The "from" and "to" options are case-sensitive and must match exactly
the names of the Parser and Producer classes in SQL::Translator. For
a complete listing of your options, execute "sqlt" with the "--list"
flag.
=head1 EXTRACT SQL SCHEMAS DIRECTLY FROM DATABASE
It is possible to extract some schemas directly from the database
without parsing a text file (the "foo.sql" in the above example).
This can prove significantly faster than parsing a text file. To
do this, use the "DBI" parser and provide the necessary arguments to
connect to the database and indicate the producer class, like so:
$ sqlt -f DBI --dsn dbi:mysql:FOO --db-user guest \
--db-password p4ssw0rd -t PostgreSQL > foo
The "--list" option to "sqlt" will show the databases supported by
DBI parsers.
=head1 HANDLING NON-SQL DATA
Certain structured document formats can be easily thought of as
tables. SQLFairy can parse Microsoft Excel spreadsheets and
arbitrarily delimited text files just as if they were schemas which
contained only one table definition. The column names are normalized
to something sane for most databases (whitespace is converted to
underscores and non-word characters are removed), and the data in each
field is scanned to determine the appropriate data type (character,
integer, or float) and size. For instance, to convert a
comma-separated file to an SQLite database, do the following:
$ sqlt -f xSV --fs ',' -t SQLite foo.csv > foo-sqlite.sql
Additionally, there is a non-SQL representation of relational schemas namely
XML. Additionally, the only XML supported is our own version; however, it
would be fairly easy to add an XML parser for something like the TorqueDB
(http://db.apache.org/torque/) project. The actual parsing of XML should be
trivial given the number of XML parsers available, so all that would be left
would be to map the specific concepts in the source file to the Schema objects
in SQLFairy.
To convert a schema in SQLFairy's XML dialect to Oracle, do the following:
$ sqlt -f XML-SQLFairy -t Oracle foo.xml > foo-oracle.sql
=head1 SERIALIZING SCHEMAS
Parsing a schema is generally the most computationally expensive
operation performed by SQLFairy, so it may behoove you to serialize a
parsed schema if you need to perform repeated conversions. For
example, as part of a build process the author converts a MySQL schema
first to YAML, then to PostgreSQL, Oracle, SQLite and Sybase.
Additionally, a variety of documentation in HTML and images is produced.
This can be accomplished like so:
$ sqlt -f MySQL -t YAML schema-mysql.sql > schema.yaml
$ sqlt -f YAML -t Oracle schema.yaml > schema-oracle.sql
$ sqlt -f YAML -t PostgreSQL schema.yaml > schema-postgresql.sql
$ ...
SQLFairy has three serialization producers, none of which is superior
to the other in their description of a schema.
=over 4
=item * XML-SQLFairy
This is the aforementioned XML format. It is essentially a direct
mapping of the Schema objects into XML. This can also provide a very
convenient bridge to describing a schema to a non-Perl application.
Providing a producer argument to "sqlt" of just "XML" will default to
using "XML-SQLFairy."
=item * Storable
This producer stores the Schema object using Perl's Storable.pm module
available on CPAN.
=item * YAML
This producer serialized the Schema object with the very readable
structured data format of YAML (http://www.yaml.org/). Earlier
examples show serializing to YAML.
=back
=head1 VISUALIZING SQL SCHEMAS
The visualization tools in SQLFairy can graphically represent the
tables, fields, datatypes and sizes, constraints, and foreign key
relationships in a very compact and intuitive format. This can be
very beneficial in understanding and document large or small schemas.
Two producers in SQLFairy will create pseudo-E/R (entity-relationship)
diagrams:
=over 4
=item * Diagram
The first visualization tool in SQLFairy, this producer uses libgd to
draw a picture of the schema. The tables are evenly distributed in
definition order running in columns (i.e., no graphing algorithms are
used), so the many of the lines showing the foreign key relationships
may cross over each other and the table boxes. Please read the
documentation of the "sqlt-diagram" script for all the options
available to this producer.
=item * GraphViz
The layout of the GraphViz producer is far superior to the Diagram
producer as it uses the Graphviz binary from Bell Labs to create very
professional-looking graphs. There are several different layout
algorithms and node shapes available. Please see the documentation of
the "sqlt-graph" script for more information.
=back
=head1 AUTOMATED CODE-GENERATION
Given that so many applications interact with SQL databases, it's no
wonder that people have automated code to deal with this interaction.
Class::DBI from CPAN is one such module that allows a developer to
describe the relationships between tables and fields in class
declarations and then generates all the SQL to interact (SELECT,
UPDATE, DELETE, INSERT statements) at runtime. Obviously, the schema
already describes itself, so it only makes sense that you should be
able to generate this kind of code directly from the schema. The
"ClassDBI" producer in SQLFairy does just this, creating a Perl module
that inherits from Class::DBI and sets up most of the code needed to
interact with the database. Here is an example of how to do this:
$ sqlt -f MySQL -t ClassDBI foo.sql > Foo.pm
Then simply edit Foo.pm as needed and include it in your code.
=head1 CREATING A DATA DUMPER SCRIPT
The Dumper producer creates a Perl script that can select the fields
in each table and then create "INSERT" statements for each record in
the database similar to the output generated by MySQL's "mysqldump"
program:
$ sqlt -f YAML -t Dumper --dumper-db-user guest \
> --dumper-db-pass p4ssw0rd --dumper-dsn dbi:mysql:FOO \
> foo.yaml > foo-dumper.pl
And then execute the resulting script to dump the data:
$ chmod +x foo-dumper.pl
$ ./foo-dumper.pl > foo-data.sql
The dumper script also has a number of options available. Execute the
script with the "--help" flag to read about them.
=head1 DOCUMENTING WITH SQL::TRANSLATOR
SQLFairy offers two producers to help document schemas:
=over 4
=item * HTML
This producer creates a single HTML document which uses HTML
formatting to describe the Schema objects and to create hyperlinks on
foreign key relationships. This can be a surprisingly useful
documentation aid as it creates a very readable format that allows one
to jump easily to specific tables and fields. It's also possible to
plugin your own CSS to further control the presentation of the HTML.
=item * POD
This is arguably not that useful of a producer by itself, but the
number of POD-conversion tools could be used to further transform the
POD into something more interesting. The schema is basically
represented in POD sections where tables are broken down into fields,
indices, constraints, foreign keys, etc.
=back
=head1 TEMPLATE-BASED MANIPULATION OF SCHEMA OBJECTS
All of the producers which create text output could have been coded
using a templating system to mix in the dynamic output with static
text. CPAN offers several diverse templating systems, but few are as
powerful as Template Toolkit (http://www.template-toolkit.org/). You
can easily create your own producer without writing any Perl code at
all simply by writing a template using Template Toolkit's syntax. The
template will be passed a reference to the Schema object briefly
described at the beginning of this document and mentioned many times
throughout. For example, you could create a template that simply
prints the name of each table and field that looks like this:
# file: schema.tt
[% FOREACH table IN schema.get_tables %]
Table: [% table.name %]
Fields:
[% FOREACH field IN table.get_fields -%]
[% field.name %]
[% END -%]
[% END %]
And then process it like so:
$ sqlt -f YAML -t TTSchema --template schema.tt foo.yaml
To create output like this:
Table: foo
Fields:
foo_id
foo_name
For more information on Template Toolkit, please install the
"Template" module and read the POD.
=head1 FINDING THE DIFFERENCES BETWEEN TWO SCHEMAS
As mentioned above, the "sqlt-diff" schema examines two schemas and
creates SQL schema modification statements that can be used to
transform the first schema into the second. The flag syntax is
somewhat quirky:
$ sqlt-diff foo-v1.sql=MySQL foo-v2.sql=Oracle > diff.sql
As demonstrated, the schemas need not even be from the same vendor,
though this is likely to produce some spurious results as
datatypes are not currently viewed equivalent unless they match
exactly, even if they would be converted to the same. For example,
MySQL's "integer" data type would be converted to Oracle's "number,"
but the differ isn't quite smart enough yet to figure this out. Also,
as the SQL to ALTER a field definition varies from database vendor to
vendor, these statements are made using just the keyword "CHANGE" and
will likely need to be corrected for the target database.
=head1 A UNIFIED GRAPHICAL INTERFACE
Seeing all the above options and scripts, you may be pining for a
single, graphical interface to handle all these transformations and
choices. This is exactly what the "sqlt.cgi" script provides. Simply
drop this script into your web server's CGI directory and enable the
execute bit and you can point your web browser to an HTML form which
provides a simple interface to all the SQLFairy parsers and producers.
=head1 PLUGIN YOUR OWN PARSERS AND PRODUCERS
Now that you have seen how the parsers and producers interact via the
Schema objects, you may wish to create your own versions to plugin.
Producers are probably the easier concept to grok, so let's cover that
first. By far the easiest way to create custom output is to use the
TTSchema producer in conjunction with a Template Toolkit template as
described earlier. However, you can also easily pass a reference to a
subroutine that SQL::Translator can call for the production of the
output. This subroutine will be passed a single argument of the
SQL::Translator object which you can use to access the Schema objects.
Please read the POD for SQL::Translator and SQL::Translator::Schema to
learn the methods you can call. Here is a very simple example:
#!/usr/bin/perl
use strict;
use SQL::Translator;
my $input = q[
create table foo (
foo_id int not null default '0' primary key,
foo_name varchar(30) not null default ''
);
create table bar (
bar_id int not null default '0' primary key,
bar_value varchar(100) not null default ''
);
];
my $t = SQL::Translator->new;
$t->parser('MySQL') or die $t->error;
$t->producer( \&produce ) or die $t->error;
my $output = $t->translate( \$input ) or die $t->error;
print $output;
sub produce {
my $tr = shift;
my $schema = $tr->schema;
my $output = '';
for my $t ( $schema->get_tables ) {
$output .= join('', "Table = ", $t->name, "\n");
}
return $output;
}
Executing this script produces the following:
$ ./my-producer.pl
Table = foo
Table = bar
A custom parser will be passed two arguments: the SQL::Translator
object and the data to be parsed. In this example, the schema will be
represented in a simple text format. Each line is a table definition
where the fields are separated by colons. The first field is the
table name and the following fields are column definitions where the
column name, data type and size are separated by spaces. The
specifics of the example are unimportant -- what is being demonstrated
is that you have to decide how to parse the incoming data and then
map the concepts in the data to the Schema object.
#!/usr/bin/perl
use strict;
use SQL::Translator;
my $input =
"foo:foo_id int 11:foo_name varchar 30\n" .
"bar:bar_id int 11:bar_value varchar 30"
;
my $t = SQL::Translator->new;
$t->parser( \&parser ) or die $t->error;
$t->producer('Oracle') or die $t->error;
my $output = $t->translate( \$input ) or die $t->error;
print $output;
sub parser {
my ( $tr, $data ) = @_;
my $schema = $tr->schema;
for my $line ( split( /\n/, $data ) ) {
my ( $table_name, @fields ) = split( /:/, $line );
my $table = $schema->add_table( name => $table_name )
or die $schema->error;
for ( @fields ) {
my ( $f_name, $type, $size ) = split;
$table->add_field(
name => $f_name,
data_type => $type,
size => $size,
) or die $table->error;
}
}
return 1;
}
And here is the output produced by this script:
--
-- Created by SQL::Translator::Producer::Oracle
-- Created on Wed Mar 31 15:43:30 2004
--
--
-- Table: foo
--
CREATE TABLE foo (
foo_id number(11),
foo_name varchar2(30)
);
--
-- Table: bar
--
CREATE TABLE bar (
bar_id number(11),
bar_value varchar2(30)
);
If you create a useful parser or producer, you are encouraged to
submit your work to the SQLFairy project!
=head1 PLUGIN TEMPLATE TOOLKIT PRODUCERS
You may find that the TTSchema producer doesn't give you enough control over
templating and you want to play with the Template config or add you own
variables. Or maybe you just have a really good template you want to submit to
SQLFairy :) If so, the SQL::Translator::Producer::TT::Base producer may be
just for you! Instead of working like a normal producer it provides a base
class so you can cheaply build new producer modules based on templates.
It's simplest use is when we just want to put a single template in its own
module. So to create a Foo producer we create a F file as
follows, putting our template in the __DATA__ section.
package Custom::Foo.pm;
use base qw/SQL::Translator::Producer::TT::Base/;
# Use our new class as the producer
sub produce { return __PACKAGE__->new( translator => shift )->run; };
__DATA__
[% FOREACH table IN schema.get_tables %]
Table: [% table.name %]
Fields:
[% FOREACH field IN table.get_fields -%]
[% field.name %]
[% END -%]
[% END %]
For that we get a producer called Custom::Foo that we can now call like a
normal producer (as long as the directory with F is in our @INC
path):
$ sqlt -f YAML -t Custom-Foo foo.yaml
The template gets variables of C and C to use in building
its output. You also get a number of methods you can override to hook into the
template generation.
B Allows you to set the config options used by the Template object.
The Template Toolkit provides a huge number of options which allow you to do all
sorts of magic (See L for details). This method
provides a hook into them by returning a hash of options for the Template. e.g.
Say you want to use the INTERPOLATE option to save some typing in your template;
sub tt_config { ( INTERPOLATE => 1 ); }
Another common use for this is to add you own filters to the template:
sub tt_config {(
INTERPOLATE => 1,
FILTERS => { foo_filter => \&foo_filter, }
);}
Another common extension is adding your own template variables. This is done
with B:
sub tt_vars { ( foo => "bar" ); }
What about using template files instead of DATA sections? You can already - if
you give a template on the command line your new producer will use that instead
of reading the DATA section:
$ sqlt -f YAML -t Custom-Foo --template foo.tt foo.yaml
This is useful as you can set up a producer that adds a set of filters and
variables that you can then use in templates given on the command line. (There
is also a tt_schema method to over ride if you need even finer control over the
source of your template). Note that if you leave out the DATA section all
together then your producer will require a template file name to be given.
See L for more details.
=head1 AUTHOR
Ken Y. Clark Ekclark@cpan.orgE.
SQL-Translator-0.11018/lib/SQL/Translator/Filter/ 0000755 0001750 0001750 00000000000 12234461403 017724 5 ustar frew frew SQL-Translator-0.11018/lib/SQL/Translator/Filter/DefaultExtra.pm 0000644 0001750 0001750 00000003077 12143357340 022664 0 ustar frew frew package SQL::Translator::Filter::DefaultExtra;
=head1 NAME
SQL::Translator::Filter::DefaultExtra - Set default extra data values for schema
objects.
=head1 SYNOPSIS
use SQL::Translator;
my $sqlt = SQL::Translator->new(
from => 'MySQL',
to => 'MySQL',
filters => [
DefaultExtra => {
# XXX - These should really be ordered
# Default widget for fields to basic text edit.
'field.widget' => 'text',
# idea:
'field(data_type=BIT).widget' => 'yesno',
# Default label (human formated name) for fields and tables
'field.label' => '=ucfirst($name)',
'table.label' => '=ucfirst($name)',
},
],
) || die "SQLFairy error : ".SQL::Translator->error;
my $sql = $sqlt->translate || die "SQLFairy error : ".$sqlt->error;
=cut
use strict;
use warnings;
our $VERSION = '1.59';
sub filter {
my $schema = shift;
my %args = { +shift };
# Tables
foreach ( $schema->get_tables ) {
my %extra = $_->extra;
$extra{label} ||= ucfirst($_->name);
$_->extra( %extra );
}
# Fields
foreach ( map { $_->get_fields } $schema->get_tables ) {
my %extra = $_->extra;
$extra{label} ||= ucfirst($_->name);
$_->extra( %extra );
}
}
1;
__END__
=head1 DESCRIPTION
Maybe I'm trying to do too much in one go. Args set a match and then an update,
if you want to set lots of things, use lots of filters!
=head1 SEE ALSO
L, L
=head1 BUGS
=head1 TODO
=head1 AUTHOR
=cut
SQL-Translator-0.11018/lib/SQL/Translator/Filter/Names.pm 0000644 0001750 0001750 00000006657 12143357340 021346 0 ustar frew frew package SQL::Translator::Filter::Names;
=head1 NAME
SQL::Translator::Filter::Names - Tweak the names of schema objects.
=head1 SYNOPSIS
#! /usr/bin/perl -w
use SQL::Translator;
# Lowercase all table names and upper case the first letter of all field
# names. (MySql style!)
#
my $sqlt = SQL::Translator->new(
filename => \@ARGV,
from => 'MySQL',
to => 'MySQL',
filters => [
Names => {
'tables' => 'lc',
'fields' => 'ucfirst',
},
],
) || die "SQLFairy error : ".SQL::Translator->error;
print($sqlt->translate) || die "SQLFairy error : ".$sqlt->error;
=cut
use strict;
use warnings;
our $VERSION = '1.59';
sub filter {
my $schema = shift;
my %args = %{$_[0]};
# Tables
#if ( my $func = $args{tables} ) {
# _filtername($_,$func) foreach ( $schema->get_tables );
#}
# ,
foreach my $type ( qw/tables procedures triggers views/ ) {
if ( my $func = $args{$type} ) {
my $meth = "get_$type";
_filtername($_,$func) foreach $schema->$meth;
}
}
# Fields
if ( my $func = $args{fields} ) {
_filtername($_,$func)
foreach map { $_->get_fields } $schema->get_tables ;
}
}
# _filtername( OBJ, FUNC_NAME )
# Update the name attribute on the schema object given using the named filter.
# Objects with no name are skipped.
# Returns true if the name was changed. Dies if there is an error running func.
sub _filtername {
my ($obj,$func) = @_;
return unless my $name = $obj->name;
$func = _getfunc($func);
my $newname = eval { $func->($name) };
die "$@" if $@; # TODO - Better message!
return if $name eq $newname;
$_->name($newname);
}
# _getfunc( NAME ) - Returns code ref to func NAME or dies.
sub _getfunc {
my ($name) = @_;
no strict 'refs';
my $func = "SQL::Translator::Filter::Names::$name";
die "Table name filter - unknown function '$name'\n" unless exists &$func;
\&$func;
}
# The name munging functions
#=============================================================================
# Get called with name to munge as first arg and return the new name. Die on
# errors.
sub lc { lc shift; }
sub uc { uc shift; }
sub ucfirst { ucfirst shift; }
1; #==========================================================================
__END__
=head1 DESCRIPTION
=head1 SEE ALSO
L, L
=head1 BUGS
=head1 TODO
=over 4
=item Name Groups
Define a bunch of useful groups to run the name filters over. e.g. all, fkeys,
pkeys etc.
=item More Functions
e.g. camelcase, titlecase, single word etc.
Also a way to pass in a regexp.
May also want a way to pass in arguments for the func e.g. prefix.
=item Multiple Filters on the same name (filter order)?
Do we actually need this, you could just run lots of filters. Would make adding
func args to the interface easier.
filters => [
[ 'Names', { all => 'lc' } ],
[ 'Names', {
tables => 'lc',
fields => 'ucfirst',
} ],
],
Mind you if you could give the filter a list this wouldn't be a problem!
filters => [
[ 'Names',
all => 'lc'
fields => 'ucfirst',
],
],
Which is nice. Might have to change the calling conventions for filters.
Would also provide an order to run the filters in rather than having to hard
code it into the filter it's self.
=back
=head1 AUTHOR
=cut
SQL-Translator-0.11018/lib/SQL/Translator/Filter/Globals.pm 0000644 0001750 0001750 00000012063 12234455220 021647 0 ustar frew frew package SQL::Translator::Filter::Globals;
=head1 NAME
SQL::Translator::Filter::Globals - Add global fields and indices to all tables.
=head1 SYNOPSIS
# e.g. Add timestamp field to all tables.
use SQL::Translator;
my $sqlt = SQL::Translator->new(
from => 'MySQL',
to => 'MySQL',
filters => [
Globals => {
fields => [
{
name => 'modified'
data_type => 'TIMESTAMP'
}
],
indices => [
{
fields => 'modifed',
},
]
constraints => [
{
}
]
},
],
) || die "SQLFairy error : ".SQL::Translator->error;
my $sql = $sqlt->translate || die "SQLFairy error : ".$sqlt->error;
=cut
use strict;
use warnings;
our $VERSION = '1.59';
sub filter {
my $schema = shift;
my %args = @_;
my $global_table = $args{global_table} ||= '_GLOBAL_';
my (@global_fields, @global_indices, @global_constraints);
push @global_fields, @{ $args{fields} } if $args{fields};
push @global_indices, @{ $args{indices} } if $args{indices};
push @global_constraints, @{ $args{constraints} } if $args{constraints};
# Pull fields and indices off global table and then remove it.
if ( my $gtbl = $schema->get_table( $global_table ) ) {
foreach ( $gtbl->get_fields ) {
# We don't copy the order attrib so the added fields should get
# pushed on the end of each table.
push @global_fields, {
name => $_->name,
comments => "".$_->comments,
data_type => $_->data_type,
default_value => $_->default_value,
size => [$_->size],
extra => scalar($_->extra),
foreign_key_reference => $_->foreign_key_reference,
is_auto_increment => $_->is_auto_increment,
is_foreign_key => $_->is_foreign_key,
is_nullable => $_->is_nullable,
is_primary_key => $_->is_primary_key,
is_unique => $_->is_unique,
is_valid => $_->is_valid,
};
}
foreach ( $gtbl->get_indices ) {
push @global_indices, {
name => $_->name,
type => $_->type,
fields => [$_->fields],
options => [$_->options],
extra => scalar($_->extra),
};
}
foreach ( $gtbl->get_constraints ) {
push @global_constraints, {
name => $_->name,
fields => [$_->fields],
deferrable => $_->deferrable,
expression => $_->expression,
match_type => $_->match_type,
options => [$_->options],
on_delete => $_->on_delete,
on_update => $_->on_update,
reference_fields => [$_->reference_fields],
reference_table => $_->reference_table,
table => $_->table,
type => $_->type,
extra => scalar($_->extra),
};
}
$schema->drop_table($gtbl);
}
# Add globals to tables
foreach my $tbl ( $schema->get_tables ) {
foreach my $new_fld ( @global_fields ) {
# Don't add if field already there
next if $tbl->get_field( $new_fld->{name} );
$tbl->add_field( %$new_fld );
}
foreach my $new_index ( @global_indices ) {
$tbl->add_index( %$new_index );
}
foreach my $new_constraint ( @global_constraints ) {
$tbl->add_constraint( %$new_constraint );
}
}
}
1;
__END__
=head1 DESCRIPTION
Adds global fields, indices and constraints to all tables in the schema.
The globals to add can either be defined in the filter args or using a _GLOBAL_
table (see below).
If a table already contains a field with the same name as a global then it is
skipped for that table.
=head2 The _GLOBAL_ Table
An alternative to using the args is to add a table called C<_GLOBAL_> to the
schema and then just use the filter. Any fields and indices defined on this table
will be added to all the tables in the schema and the _GLOBAL_ table removed.
The name of the global can be changed using a C arg to the
filter.
=head1 SEE ALSO
L, L
=head1 BUGS
Will generate duplicate indices if an index already exists on a table the same
as one added globally.
Will generate duplicate constraints if a constraint already exists on a table
the same as one added globally.
=head1 TODO
Some extra data values that can be used to control the global addition. e.g.
'skip_global'.
=head1 AUTHOR
Mark Addison
=cut
SQL-Translator-0.11018/lib/SQL/Translator/Producer.pm 0000644 0001750 0001750 00000005042 12143357340 020624 0 ustar frew frew package SQL::Translator::Producer;
use strict;
use warnings;
use Scalar::Util ();
our $VERSION = '1.59';
sub produce { "" }
# Do not rely on this if you are not bundled with SQL::Translator.
# -- rjbs, 2008-09-30
## $exceptions contains an arrayref of paired values
## Each pair contains a pattern match or string, and a value to be used as
## the default if matched.
## They are special per Producer, and provide support for the old 'now()'
## default value exceptions
sub _apply_default_value {
my (undef, $field, $field_ref, $exceptions) = @_;
my $default = $field->default_value;
return if !defined $default;
if ($exceptions and ! ref $default) {
for (my $i = 0; $i < @$exceptions; $i += 2) {
my ($pat, $val) = @$exceptions[ $i, $i + 1 ];
if (ref $pat and $default =~ $pat) {
$default = $val;
last;
} elsif (lc $default eq lc $pat) {
$default = $val;
last
}
}
}
my $type = lc $field->data_type;
my $is_numeric_datatype = ($type =~ /^(?:(?:big|medium|small|tiny)?int(?:eger)?|decimal|double|float|num(?:ber|eric)?|real)$/);
if (ref $default) {
$$field_ref .= " DEFAULT $$default";
} elsif ($is_numeric_datatype && Scalar::Util::looks_like_number ($default) ) {
# we need to check the data itself in addition to the datatype, for basic safety
$$field_ref .= " DEFAULT $default";
} else {
$$field_ref .= " DEFAULT '$default'";
}
}
1;
# -------------------------------------------------------------------
# A burnt child loves the fire.
# Oscar Wilde
# -------------------------------------------------------------------
=pod
=head1 NAME
SQL::Translator::Producer - describes how to write a producer
=head1 DESCRIPTION
Producer modules designed to be used with SQL::Translator need to
implement a single function, called B. B will be
called with the SQL::Translator object from which it is expected to
retrieve the SQL::Translator::Schema object which has been populated
by the parser. It is expected to return a string.
=head1 METHODS
=over 4
=item produce
=item create_table($table)
=item create_field($field)
=item create_view($view)
=item create_index($index)
=item create_constraint($constraint)
=item create_trigger($trigger)
=item alter_field($from_field, $to_field)
=item add_field($table, $new_field)
=item drop_field($table, $old_field)
=back
=head1 AUTHORS
Darren Chamberlain Edarren@cpan.orgE,
Ken Y. Clark Ekclark@cpan.orgE.
=head1 SEE ALSO
perl(1), SQL::Translator, SQL::Translator::Schema.
=cut
SQL-Translator-0.11018/lib/SQL/Translator/Schema/ 0000755 0001750 0001750 00000000000 12234461403 017677 5 ustar frew frew SQL-Translator-0.11018/lib/SQL/Translator/Schema/Procedure.pm 0000644 0001750 0001750 00000010361 12143357340 022171 0 ustar frew frew package SQL::Translator::Schema::Procedure;
=pod
=head1 NAME
SQL::Translator::Schema::Procedure - SQL::Translator procedure object
=head1 SYNOPSIS
use SQL::Translator::Schema::Procedure;
my $procedure = SQL::Translator::Schema::Procedure->new(
name => 'foo',
sql => 'CREATE PROC foo AS SELECT * FROM bar',
parameters => 'foo,bar',
owner => 'nomar',
comments => 'blah blah blah',
schema => $schema,
);
=head1 DESCRIPTION
C is a class for dealing with
stored procedures (and possibly other pieces of nameable SQL code?).
=head1 METHODS
=cut
use Moo;
use SQL::Translator::Utils qw(ex2err);
use SQL::Translator::Role::ListAttr;
use SQL::Translator::Types qw(schema_obj);
use Sub::Quote qw(quote_sub);
extends 'SQL::Translator::Schema::Object';
our $VERSION = '1.59';
=head2 new
Object constructor.
my $schema = SQL::Translator::Schema::Procedure->new;
=cut
=head2 parameters
Gets and set the parameters of the stored procedure.
$procedure->parameters('id');
$procedure->parameters('id', 'name');
$procedure->parameters( 'id, name' );
$procedure->parameters( [ 'id', 'name' ] );
$procedure->parameters( qw[ id name ] );
my @parameters = $procedure->parameters;
=cut
with ListAttr parameters => ( uniq => 1 );
=head2 name
Get or set the procedure's name.
$procedure->name('foo');
my $name = $procedure->name;
=cut
has name => ( is => 'rw', default => quote_sub(q{ '' }) );
=head2 sql
Get or set the procedure's SQL.
$procedure->sql('select * from foo');
my $sql = $procedure->sql;
=cut
has sql => ( is => 'rw', default => quote_sub(q{ '' }) );
=head2 order
Get or set the order of the procedure.
$procedure->order( 3 );
my $order = $procedure->order;
=cut
has order => ( is => 'rw' );
=head2 owner
Get or set the owner of the procedure.
$procedure->owner('nomar');
my $sql = $procedure->owner;
=cut
has owner => ( is => 'rw', default => quote_sub(q{ '' }) );
=head2 comments
Get or set the comments on a procedure.
$procedure->comments('foo');
$procedure->comments('bar');
print join( ', ', $procedure->comments ); # prints "foo, bar"
=cut
has comments => (
is => 'rw',
coerce => quote_sub(q{ ref($_[0]) eq 'ARRAY' ? $_[0] : [$_[0]] }),
default => quote_sub(q{ [] }),
);
around comments => sub {
my $orig = shift;
my $self = shift;
my @comments = ref $_[0] ? @{ $_[0] } : @_;
for my $arg ( @comments ) {
$arg = $arg->[0] if ref $arg;
push @{ $self->$orig }, $arg if defined $arg && $arg;
}
return wantarray ? @{ $self->$orig } : join( "\n", @{ $self->$orig } );
};
=head2 schema
Get or set the procedures's schema object.
$procedure->schema( $schema );
my $schema = $procedure->schema;
=cut
has schema => ( is => 'rw', isa => schema_obj('Schema'), weak_ref => 1 );
around schema => \&ex2err;
=head2 equals
Determines if this procedure is the same as another
my $isIdentical = $procedure1->equals( $procedure2 );
=cut
around equals => sub {
my $orig = shift;
my $self = shift;
my $other = shift;
my $case_insensitive = shift;
my $ignore_sql = shift;
return 0 unless $self->$orig($other);
return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
unless ($ignore_sql) {
my $selfSql = $self->sql;
my $otherSql = $other->sql;
# Remove comments
$selfSql =~ s/--.*$//mg;
$otherSql =~ s/--.*$//mg;
# Collapse whitespace to space to avoid whitespace comparison issues
$selfSql =~ s/\s+/ /sg;
$otherSql =~ s/\s+/ /sg;
return 0 unless $selfSql eq $otherSql;
}
return 0 unless $self->_compare_objects(scalar $self->parameters, scalar $other->parameters);
# return 0 unless $self->comments eq $other->comments;
# return 0 unless $case_insensitive ? uc($self->owner) eq uc($other->owner) : $self->owner eq $other->owner;
return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
return 1;
};
# Must come after all 'has' declarations
around new => \&ex2err;
1;
=pod
=head1 AUTHORS
Ken Youens-Clark Ekclark@cshl.orgE,
Paul Harrington EPaul-Harrington@deshaw.comE.
=cut
SQL-Translator-0.11018/lib/SQL/Translator/Schema/Object.pm 0000644 0001750 0001750 00000002026 12143357340 021446 0 ustar frew frew package SQL::Translator::Schema::Object;
=head1 NAME
SQL::Translator::Schema::Object - Base class for SQL::Translator schema objects
=head1 SYNOPSIS
package SQL::Translator::Schema::Foo;
use Moo;
extends 'SQL::Translator::Schema::Object';
=head1 DESCRIPTION
Base class for Schema objects. A Moo class consuming the following
roles.
=over
=item L
Provides C<< $obj->error >>, similar to L.
=item L
Removes undefined constructor arguments, for backwards compatibility.
=item L
Provides an C attribute storing a hashref of arbitrary data.
=item L
Provides an C<< $obj->equals($other) >> method for testing object
equality.
=back
=cut
use Moo 1.000003;
# screw you PAUSE
our $VERSION = '1.59';
with qw(
SQL::Translator::Role::Error
SQL::Translator::Role::BuildArgs
SQL::Translator::Schema::Role::Extra
SQL::Translator::Schema::Role::Compare
);
1;
SQL-Translator-0.11018/lib/SQL/Translator/Schema/Index.pm 0000644 0001750 0001750 00000011307 12143357340 021311 0 ustar frew frew package SQL::Translator::Schema::Index;
=pod
=head1 NAME
SQL::Translator::Schema::Index - SQL::Translator index object
=head1 SYNOPSIS
use SQL::Translator::Schema::Index;
my $index = SQL::Translator::Schema::Index->new(
name => 'foo',
fields => [ id ],
type => 'unique',
);
=head1 DESCRIPTION
C is the index object.
Primary and unique keys are table constraints, not indices.
=head1 METHODS
=cut
use Moo;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(ex2err throw);
use SQL::Translator::Role::ListAttr;
use SQL::Translator::Types qw(schema_obj enum);
use Sub::Quote qw(quote_sub);
extends 'SQL::Translator::Schema::Object';
our $VERSION = '1.59';
my %VALID_INDEX_TYPE = (
UNIQUE => 1,
NORMAL => 1,
FULLTEXT => 1, # MySQL only (?)
FULL_TEXT => 1, # MySQL only (?)
SPATIAL => 1, # MySQL only (?)
);
=head2 new
Object constructor.
my $schema = SQL::Translator::Schema::Index->new;
=head2 fields
Gets and set the fields the index is on. Accepts a string, list or
arrayref; returns an array or array reference. Will unique the field
names and keep them in order by the first occurrence of a field name.
$index->fields('id');
$index->fields('id', 'name');
$index->fields( 'id, name' );
$index->fields( [ 'id', 'name' ] );
$index->fields( qw[ id name ] );
my @fields = $index->fields;
=cut
with ListAttr fields => ( uniq => 1 );
sub is_valid {
=pod
=head2 is_valid
Determine whether the index is valid or not.
my $ok = $index->is_valid;
=cut
my $self = shift;
my $table = $self->table or return $self->error('No table');
my @fields = $self->fields or return $self->error('No fields');
for my $field ( @fields ) {
return $self->error(
"Field '$field' does not exist in table '", $table->name, "'"
) unless $table->get_field( $field );
}
return 1;
}
=head2 name
Get or set the index's name.
my $name = $index->name('foo');
=cut
has name => (
is => 'rw',
coerce => quote_sub(q{ defined $_[0] ? $_[0] : '' }),
default => quote_sub(q{ '' }),
);
=head2 options
Get or set the index's options (e.g., "using" or "where" for PG). Returns
an array or array reference.
my @options = $index->options;
=cut
with ListAttr options => ();
=head2 table
Get or set the index's table object.
my $table = $index->table;
=cut
has table => ( is => 'rw', isa => schema_obj('Table'), weak_ref => 1 );
around table => \&ex2err;
=head2 type
Get or set the index's type.
my $type = $index->type('unique');
Get or set the index's type.
Currently there are only four acceptable types: UNIQUE, NORMAL, FULL_TEXT,
and SPATIAL. The latter two might be MySQL-specific. While both lowercase
and uppercase types are acceptable input, this method returns the type in
uppercase.
=cut
has type => (
is => 'rw',
coerce => quote_sub(q{ uc $_[0] }),
default => quote_sub(q{ 'NORMAL' }),
isa => enum([keys %VALID_INDEX_TYPE], {
msg => "Invalid index type: %s", allow_false => 1,
}),
);
around type => \&ex2err;
=head2 equals
Determines if this index is the same as another
my $isIdentical = $index1->equals( $index2 );
=cut
around equals => sub {
my $orig = shift;
my $self = shift;
my $other = shift;
my $case_insensitive = shift;
my $ignore_index_names = shift;
return 0 unless $self->$orig($other);
unless ($ignore_index_names) {
unless ((!$self->name && ($other->name eq $other->fields->[0])) ||
(!$other->name && ($self->name eq $self->fields->[0]))) {
return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
}
}
#return 0 unless $self->is_valid eq $other->is_valid;
return 0 unless $self->type eq $other->type;
# Check fields, regardless of order
my %otherFields = (); # create a hash of the other fields
foreach my $otherField ($other->fields) {
$otherField = uc($otherField) if $case_insensitive;
$otherFields{$otherField} = 1;
}
foreach my $selfField ($self->fields) { # check for self fields in hash
$selfField = uc($selfField) if $case_insensitive;
return 0 unless $otherFields{$selfField};
delete $otherFields{$selfField};
}
# Check all other fields were accounted for
return 0 unless keys %otherFields == 0;
return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
return 1;
};
# Must come after all 'has' declarations
around new => \&ex2err;
1;
=pod
=head1 AUTHOR
Ken Youens-Clark Ekclark@cpan.orgE.
=cut
SQL-Translator-0.11018/lib/SQL/Translator/Schema/Role/ 0000755 0001750 0001750 00000000000 12234461403 020600 5 ustar frew frew SQL-Translator-0.11018/lib/SQL/Translator/Schema/Role/Extra.pm 0000644 0001750 0001750 00000003566 12234455220 022233 0 ustar frew frew package SQL::Translator::Schema::Role::Extra;
=head1 NAME
SQL::Translator::Schema::Role::Extra - "extra" attribute for schema classes
=head1 SYNOPSIS
package Foo;
use Moo;
with qw(SQL::Translator::Schema::Role::Extra);
=head1 DESCRIPTION
This role provides methods to set and get a hashref of extra attributes
for schema objects.
=cut
use Moo::Role;
use Sub::Quote qw(quote_sub);
=head1 METHODS
=head2 extra
Get or set the objects "extra" attributes (e.g., "ZEROFILL" for MySQL fields).
Call with no args to get all the extra data.
Call with a single name arg to get the value of the named extra attribute,
returned as a scalar. Call with a hash or hashref to set extra attributes.
Returns a hash or a hashref.
$field->extra( qualifier => 'ZEROFILL' );
$qualifier = $field->extra('qualifier');
%extra = $field->extra;
$extra = $field->extra;
=cut
has extra => ( is => 'rwp', default => quote_sub(q{ +{} }) );
around extra => sub {
my ($orig, $self) = (shift, shift);
@_ = %{$_[0]} if ref $_[0] eq "HASH";
my $extra = $self->$orig;
if (@_==1) {
return $extra->{$_[0]};
}
elsif (@_) {
my %args = @_;
while ( my ( $key, $value ) = each %args ) {
$extra->{$key} = $value;
}
}
return wantarray ? %$extra : $extra;
};
=head2 remove_extra
L can only be used to get or set "extra" attributes but not to
remove some. Call with no args to remove all extra attributes that
have been set before. Call with a list of key names to remove
certain extra attributes only.
# remove all extra attributes
$field->remove_extra();
# remove timezone and locale attributes only
$field->remove_extra(qw/timezone locale/);
=cut
sub remove_extra {
my ( $self, @keys ) = @_;
unless (@keys) {
$self->_set_extra({});
}
else {
delete @{$self->extra}{@keys};
}
}
1;
SQL-Translator-0.11018/lib/SQL/Translator/Schema/Role/Compare.pm 0000644 0001750 0001750 00000002364 12143357340 022534 0 ustar frew frew package SQL::Translator::Schema::Role::Compare;
=head1 NAME
SQL::Translator::Schema::Role::Compare - compare objects
=head1 SYNOPSIS
package Foo;
use Moo;
with qw(SQL::Translator::Schema::Role::Compare);
$obj->equals($other);
=head1 DESCRIPTION
This L provides a method to compare if two objects are the
same.
=cut
use Moo::Role;
=head1 METHODS
=head2 equals
Determines if this object is the same as another.
my $isIdentical = $object1->equals( $object2 );
=cut
sub equals {
my $self = shift;
my $other = shift;
return 0 unless $other;
return 1 if overload::StrVal($self) eq overload::StrVal($other);
return 0 unless $other->isa( ref($self) );
return 1;
}
sub _compare_objects {
# my ($self, $obj1, $obj2) = @_;
my $result = (
Data::Dumper->new([$_[1]])->Terse(1)->Indent(0)->Deparse(1)->Sortkeys(1)->Maxdepth(0)->Dump
eq
Data::Dumper->new([$_[2]])->Terse(1)->Indent(0)->Deparse(1)->Sortkeys(1)->Maxdepth(0)->Dump
);
# if ( !$result ) {
# use Carp qw(cluck);
# cluck("How did I get here?");
# use Data::Dumper;
# $Data::Dumper::Maxdepth = 1;
# print "obj1: ", Dumper($obj1), "\n";
# print "obj2: ", Dumper($obj2), "\n";
# }
return $result;
}
1;
SQL-Translator-0.11018/lib/SQL/Translator/Schema/Field.pm 0000644 0001750 0001750 00000030274 12234455220 021266 0 ustar frew frew package SQL::Translator::Schema::Field;
=pod
=head1 NAME
SQL::Translator::Schema::Field - SQL::Translator field object
=head1 SYNOPSIS
use SQL::Translator::Schema::Field;
my $field = SQL::Translator::Schema::Field->new(
name => 'foo',
table => $table,
);
=head1 DESCRIPTION
C is the field object.
=head1 METHODS
=cut
use Moo;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Types qw(schema_obj);
use SQL::Translator::Utils qw(parse_list_arg ex2err throw carp_ro);
use Sub::Quote qw(quote_sub);
extends 'SQL::Translator::Schema::Object';
our $VERSION = '1.59';
# Stringify to our name, being careful not to pass any args through so we don't
# accidentally set it to undef. We also have to tweak bool so the object is
# still true when it doesn't have a name (which shouldn't happen!).
use overload
'""' => sub { shift->name },
'bool' => sub { $_[0]->name || $_[0] },
fallback => 1,
;
use DBI qw(:sql_types);
# Mapping from string to sql constant
our %type_mapping = (
integer => SQL_INTEGER,
int => SQL_INTEGER,
tinyint => SQL_TINYINT,
smallint => SQL_SMALLINT,
bigint => SQL_BIGINT,
double => SQL_DOUBLE,
decimal => SQL_DECIMAL,
numeric => SQL_NUMERIC,
dec => SQL_DECIMAL,
bit => SQL_BIT,
date => SQL_DATE,
datetime => SQL_DATETIME,
timestamp => SQL_TIMESTAMP,
time => SQL_TIME,
char => SQL_CHAR,
varchar => SQL_VARCHAR,
binary => SQL_BINARY,
varbinary => SQL_VARBINARY,
tinyblob => SQL_BLOB,
blob => SQL_BLOB,
text => SQL_LONGVARCHAR
);
=head2 new
Object constructor.
my $field = SQL::Translator::Schema::Field->new(
name => 'foo',
table => $table,
);
=head2 comments
Get or set the comments on a field. May be called several times to
set and it will accumulate the comments. Called in an array context,
returns each comment individually; called in a scalar context, returns
all the comments joined on newlines.
$field->comments('foo');
$field->comments('bar');
print join( ', ', $field->comments ); # prints "foo, bar"
=cut
has comments => (
is => 'rw',
coerce => quote_sub(q{ ref($_[0]) eq 'ARRAY' ? $_[0] : [$_[0]] }),
default => quote_sub(q{ [] }),
);
around comments => sub {
my $orig = shift;
my $self = shift;
for my $arg ( @_ ) {
$arg = $arg->[0] if ref $arg;
push @{ $self->$orig }, $arg if $arg;
}
return wantarray
? @{ $self->$orig }
: join( "\n", @{ $self->$orig } );
};
=head2 data_type
Get or set the field's data type.
my $data_type = $field->data_type('integer');
=cut
has data_type => ( is => 'rw', default => quote_sub(q{ '' }) );
=head2 sql_data_type
Constant from DBI package representing this data type. See L
for more details.
=cut
has sql_data_type => ( is => 'rw', lazy => 1, builder => 1 );
sub _build_sql_data_type {
$type_mapping{lc $_[0]->data_type} || SQL_UNKNOWN_TYPE;
}
=head2 default_value
Get or set the field's default value. Will return undef if not defined
and could return the empty string (it's a valid default value), so don't
assume an error like other methods.
my $default = $field->default_value('foo');
=cut
has default_value => ( is => 'rw' );
=head2 foreign_key_reference
Get or set the field's foreign key reference;
my $constraint = $field->foreign_key_reference( $constraint );
=cut
has foreign_key_reference => (
is => 'rw',
predicate => '_has_foreign_key_reference',
isa => schema_obj('Constraint'),
weak_ref => 1,
);
around foreign_key_reference => sub {
my $orig = shift;
my $self = shift;
if ( my $arg = shift ) {
return $self->error(
'Foreign key reference for ', $self->name, 'already defined'
) if $self->_has_foreign_key_reference;
return ex2err($orig, $self, $arg);
}
$self->$orig;
};
=head2 is_auto_increment
Get or set the field's C attribute.
my $is_auto = $field->is_auto_increment(1);
=cut
has is_auto_increment => (
is => 'rw',
coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
builder => 1,
lazy => 1,
);
sub _build_is_auto_increment {
my ( $self ) = @_;
if ( my $table = $self->table ) {
if ( my $schema = $table->schema ) {
if (
$schema->database eq 'PostgreSQL' &&
$self->data_type eq 'serial'
) {
return 1;
}
}
}
return 0;
}
=head2 is_foreign_key
Returns whether or not the field is a foreign key.
my $is_fk = $field->is_foreign_key;
=cut
has is_foreign_key => (
is => 'rw',
coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
builder => 1,
lazy => 1,
);
sub _build_is_foreign_key {
my ( $self ) = @_;
if ( my $table = $self->table ) {
for my $c ( $table->get_constraints ) {
if ( $c->type eq FOREIGN_KEY ) {
my %fields = map { $_, 1 } $c->fields;
if ( $fields{ $self->name } ) {
$self->foreign_key_reference( $c );
return 1;
}
}
}
}
return 0;
}
=head2 is_nullable
Get or set whether the field can be null. If not defined, then
returns "1" (assumes the field can be null). The argument is evaluated
by Perl for True or False, so the following are equivalent:
$is_nullable = $field->is_nullable(0);
$is_nullable = $field->is_nullable('');
$is_nullable = $field->is_nullable('0');
While this is technically a field constraint, it's probably easier to
represent this as an attribute of the field. In order keep things
consistent, any other constraint on the field (unique, primary, and
foreign keys; checks) are represented as table constraints.
=cut
has is_nullable => (
is => 'rw',
coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
default => quote_sub(q{ 1 }),
);
around is_nullable => sub {
my ($orig, $self, $arg) = @_;
$self->$orig($self->is_primary_key ? 0 : defined $arg ? $arg : ());
};
=head2 is_primary_key
Get or set the field's C attribute. Does not create
a table constraint (should it?).
my $is_pk = $field->is_primary_key(1);
=cut
has is_primary_key => (
is => 'rw',
coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
lazy => 1,
builder => 1,
);
sub _build_is_primary_key {
my ( $self ) = @_;
if ( my $table = $self->table ) {
if ( my $pk = $table->primary_key ) {
my %fields = map { $_, 1 } $pk->fields;
return $fields{ $self->name } || 0;
}
}
return 0;
}
=head2 is_unique
Determine whether the field has a UNIQUE constraint or not.
my $is_unique = $field->is_unique;
=cut
has is_unique => ( is => 'lazy', init_arg => undef );
around is_unique => carp_ro('is_unique');
sub _build_is_unique {
my ( $self ) = @_;
if ( my $table = $self->table ) {
for my $c ( $table->get_constraints ) {
if ( $c->type eq UNIQUE ) {
my %fields = map { $_, 1 } $c->fields;
if ( $fields{ $self->name } ) {
return 1;
}
}
}
}
return 0;
}
sub is_valid {
=pod
=head2 is_valid
Determine whether the field is valid or not.
my $ok = $field->is_valid;
=cut
my $self = shift;
return $self->error('No name') unless $self->name;
return $self->error('No data type') unless $self->data_type;
return $self->error('No table object') unless $self->table;
return 1;
}
=head2 name
Get or set the field's name.
my $name = $field->name('foo');
The field object will also stringify to its name.
my $setter_name = "set_$field";
Errors ("No field name") if you try to set a blank name.
=cut
has name => ( is => 'rw', isa => sub { throw( "No field name" ) unless $_[0] } );
around name => sub {
my $orig = shift;
my $self = shift;
if ( my ($arg) = @_ ) {
if ( my $schema = $self->table ) {
return $self->error( qq[Can't use field name "$arg": field exists] )
if $schema->get_field( $arg );
}
}
return ex2err($orig, $self, @_);
};
sub full_name {
=head2 full_name
Read only method to return the fields name with its table name pre-pended.
e.g. "person.foo".
=cut
my $self = shift;
return $self->table.".".$self->name;
}
=head2 order
Get or set the field's order.
my $order = $field->order(3);
=cut
has order => ( is => 'rw', default => quote_sub(q{ 0 }) );
around order => sub {
my ( $orig, $self, $arg ) = @_;
if ( defined $arg && $arg =~ /^\d+$/ ) {
return $self->$orig($arg);
}
return $self->$orig;
};
sub schema {
=head2 schema
Shortcut to get the fields schema ($field->table->schema) or undef if it
doesn't have one.
my $schema = $field->schema;
=cut
my $self = shift;
if ( my $table = $self->table ) { return $table->schema || undef; }
return undef;
}
=head2 size
Get or set the field's size. Accepts a string, array or arrayref of
numbers and returns a string.
$field->size( 30 );
$field->size( [ 255 ] );
$size = $field->size( 10, 2 );
print $size; # prints "10,2"
$size = $field->size( '10, 2' );
print $size; # prints "10,2"
=cut
has size => (
is => 'rw',
default => quote_sub(q{ [0] }),
coerce => sub {
my @sizes = grep { defined && m/^\d+(?:\.\d+)?$/ } @{parse_list_arg($_[0])};
@sizes ? \@sizes : [0];
},
);
around size => sub {
my $orig = shift;
my $self = shift;
my $numbers = parse_list_arg( @_ );
if ( @$numbers ) {
my @new;
for my $num ( @$numbers ) {
if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
push @new, $num;
}
}
$self->$orig(\@new) if @new; # only set if all OK
}
return wantarray
? @{ $self->$orig || [0] }
: join( ',', @{ $self->$orig || [0] } )
;
};
=head2 table
Get or set the field's table object. As the table object stringifies this can
also be used to get the table name.
my $table = $field->table;
print "Table name: $table";
=cut
has table => ( is => 'rw', isa => schema_obj('Table'), weak_ref => 1 );
around table => \&ex2err;
=head2 parsed_field
Returns the field exactly as the parser found it
=cut
has parsed_field => ( is => 'rw' );
around parsed_field => sub {
my $orig = shift;
my $self = shift;
return $self->$orig(@_) || $self;
};
=head2 equals
Determines if this field is the same as another
my $isIdentical = $field1->equals( $field2 );
=cut
around equals => sub {
my $orig = shift;
my $self = shift;
my $other = shift;
my $case_insensitive = shift;
return 0 unless $self->$orig($other);
return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
# Comparing types: use sql_data_type if both are not 0. Else use string data_type
if ($self->sql_data_type && $other->sql_data_type) {
return 0 unless $self->sql_data_type == $other->sql_data_type
} else {
return 0 unless lc($self->data_type) eq lc($other->data_type)
}
return 0 unless $self->size eq $other->size;
{
my $lhs = $self->default_value;
$lhs = \'NULL' unless defined $lhs;
my $lhs_is_ref = ! ! ref $lhs;
my $rhs = $other->default_value;
$rhs = \'NULL' unless defined $rhs;
my $rhs_is_ref = ! ! ref $rhs;
# If only one is a ref, fail. -- rjbs, 2008-12-02
return 0 if $lhs_is_ref xor $rhs_is_ref;
my $effective_lhs = $lhs_is_ref ? $$lhs : $lhs;
my $effective_rhs = $rhs_is_ref ? $$rhs : $rhs;
return 0 if $effective_lhs ne $effective_rhs;
}
return 0 unless $self->is_nullable eq $other->is_nullable;
# return 0 unless $self->is_unique eq $other->is_unique;
return 0 unless $self->is_primary_key eq $other->is_primary_key;
# return 0 unless $self->is_foreign_key eq $other->is_foreign_key;
return 0 unless $self->is_auto_increment eq $other->is_auto_increment;
# return 0 unless $self->comments eq $other->comments;
return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
return 1;
};
# Must come after all 'has' declarations
around new => \&ex2err;
1;
=pod
=head1 AUTHOR
Ken Youens-Clark Ekclark@cpan.orgE.
=cut
SQL-Translator-0.11018/lib/SQL/Translator/Schema/Constraint.pm 0000644 0001750 0001750 00000027535 12234455220 022375 0 ustar frew frew package SQL::Translator::Schema::Constraint;
=pod
=head1 NAME
SQL::Translator::Schema::Constraint - SQL::Translator constraint object
=head1 SYNOPSIS
use SQL::Translator::Schema::Constraint;
my $constraint = SQL::Translator::Schema::Constraint->new(
name => 'foo',
fields => [ id ],
type => PRIMARY_KEY,
);
=head1 DESCRIPTION
C is the constraint object.
=head1 METHODS
=cut
use Moo;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(ex2err throw);
use SQL::Translator::Role::ListAttr;
use SQL::Translator::Types qw(schema_obj enum);
use Sub::Quote qw(quote_sub);
extends 'SQL::Translator::Schema::Object';
our $VERSION = '1.59';
my %VALID_CONSTRAINT_TYPE = (
PRIMARY_KEY, 1,
UNIQUE, 1,
CHECK_C, 1,
FOREIGN_KEY, 1,
NOT_NULL, 1,
);
=head2 new
Object constructor.
my $schema = SQL::Translator::Schema::Constraint->new(
table => $table, # table to which it belongs
type => 'foreign_key', # type of table constraint
name => 'fk_phone_id', # name of the constraint
fields => 'phone_id', # field in the referring table
reference_fields => 'phone_id', # referenced field
reference_table => 'phone', # referenced table
match_type => 'full', # how to match
on_delete => 'cascade', # what to do on deletes
on_update => '', # what to do on updates
);
=cut
# Override to remove empty arrays from args.
# t/14postgres-parser breaks without this.
around BUILDARGS => sub {
my $orig = shift;
my $self = shift;
my $args = $self->$orig(@_);
foreach my $arg (keys %{$args}) {
delete $args->{$arg} if ref($args->{$arg}) eq "ARRAY" && !@{$args->{$arg}};
}
if (exists $args->{fields}) {
$args->{field_names} = delete $args->{fields};
}
return $args;
};
=head2 deferrable
Get or set whether the constraint is deferrable. If not defined,
then returns "1." The argument is evaluated by Perl for True or
False, so the following are equivalent:
$deferrable = $field->deferrable(0);
$deferrable = $field->deferrable('');
$deferrable = $field->deferrable('0');
=cut
has deferrable => (
is => 'rw',
coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
default => quote_sub(q{ 1 }),
);
=head2 expression
Gets and set the expression used in a CHECK constraint.
my $expression = $constraint->expression('...');
=cut
has expression => ( is => 'rw', default => quote_sub(q{ '' }) );
around expression => sub {
my ($orig, $self, $arg) = @_;
$self->$orig($arg || ());
};
sub is_valid {
=pod
=head2 is_valid
Determine whether the constraint is valid or not.
my $ok = $constraint->is_valid;
=cut
my $self = shift;
my $type = $self->type or return $self->error('No type');
my $table = $self->table or return $self->error('No table');
my @fields = $self->fields or return $self->error('No fields');
my $table_name = $table->name or return $self->error('No table name');
for my $f ( @fields ) {
next if $table->get_field( $f );
return $self->error(
"Constraint references non-existent field '$f' ",
"in table '$table_name'"
);
}
my $schema = $table->schema or return $self->error(
'Table ', $table->name, ' has no schema object'
);
if ( $type eq FOREIGN_KEY ) {
return $self->error('Only one field allowed for foreign key')
if scalar @fields > 1;
my $ref_table_name = $self->reference_table or
return $self->error('No reference table');
my $ref_table = $schema->get_table( $ref_table_name ) or
return $self->error("No table named '$ref_table_name' in schema");
my @ref_fields = $self->reference_fields or return;
return $self->error('Only one field allowed for foreign key reference')
if scalar @ref_fields > 1;
for my $ref_field ( @ref_fields ) {
next if $ref_table->get_field( $ref_field );
return $self->error(
"Constraint from field(s) ".
join(', ', map {qq['$table_name.$_']} @fields).
" to non-existent field '$ref_table_name.$ref_field'"
);
}
}
elsif ( $type eq CHECK_C ) {
return $self->error('No expression for CHECK') unless
$self->expression;
}
return 1;
}
=head2 fields
Gets and set the fields the constraint is on. Accepts a string, list or
arrayref; returns an array or array reference. Will unique the field
names and keep them in order by the first occurrence of a field name.
The fields are returned as Field objects if they exist or as plain
names if not. (If you just want the names and want to avoid the Field's overload
magic use L).
Returns undef or an empty list if the constraint has no fields set.
$constraint->fields('id');
$constraint->fields('id', 'name');
$constraint->fields( 'id, name' );
$constraint->fields( [ 'id', 'name' ] );
$constraint->fields( qw[ id name ] );
my @fields = $constraint->fields;
=cut
sub fields {
my $self = shift;
my $table = $self->table;
my @tables = map { $table->get_field($_) || $_ } @{$self->field_names(@_) || []};
return wantarray ? @tables
: @tables ? \@tables
: undef;
}
=head2 field_names
Read-only method to return a list or array ref of the field names. Returns undef
or an empty list if the constraint has no fields set. Useful if you want to
avoid the overload magic of the Field objects returned by the fields method.
my @names = $constraint->field_names;
=cut
with ListAttr field_names => ( uniq => 1, undef_if_empty => 1 );
=head2 match_type
Get or set the constraint's match_type. Only valid values are "full"
"partial" and "simple"
my $match_type = $constraint->match_type('FULL');
=cut
has match_type => (
is => 'rw',
default => quote_sub(q{ '' }),
coerce => quote_sub(q{ lc $_[0] }),
isa => enum([qw(full partial simple)], {
msg => "Invalid match type: %s", allow_false => 1,
}),
);
around match_type => \&ex2err;
=head2 name
Get or set the constraint's name.
my $name = $constraint->name('foo');
=cut
has name => ( is => 'rw', default => quote_sub(q{ '' }) );
around name => sub {
my ($orig, $self, $arg) = @_;
$self->$orig($arg || ());
};
=head2 options
Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE").
Returns an array or array reference.
$constraint->options('NORELY');
my @options = $constraint->options;
=cut
with ListAttr options => ();
=head2 on_delete
Get or set the constraint's "on delete" action.
my $action = $constraint->on_delete('cascade');
=cut
has on_delete => ( is => 'rw', default => quote_sub(q{ '' }) );
around on_delete => sub {
my ($orig, $self, $arg) = @_;
$self->$orig($arg || ());
};
=head2 on_update
Get or set the constraint's "on update" action.
my $action = $constraint->on_update('no action');
=cut
has on_update => ( is => 'rw', default => quote_sub(q{ '' }) );
around on_update => sub {
my ($orig, $self, $arg) = @_;
$self->$orig($arg || ());
};
=head2 reference_fields
Gets and set the fields in the referred table. Accepts a string, list or
arrayref; returns an array or array reference.
$constraint->reference_fields('id');
$constraint->reference_fields('id', 'name');
$constraint->reference_fields( 'id, name' );
$constraint->reference_fields( [ 'id', 'name' ] );
$constraint->reference_fields( qw[ id name ] );
my @reference_fields = $constraint->reference_fields;
=cut
with ListAttr reference_fields => (
may_throw => 1,
builder => 1,
lazy => 1,
);
sub _build_reference_fields {
my ($self) = @_;
my $table = $self->table or throw('No table');
my $schema = $table->schema or throw('No schema');
if ( my $ref_table_name = $self->reference_table ) {
my $ref_table = $schema->get_table( $ref_table_name ) or
throw("Can't find table '$ref_table_name'");
if ( my $constraint = $ref_table->primary_key ) {
return [ $constraint->fields ];
}
else {
throw(
'No reference fields defined and cannot find primary key in ',
"reference table '$ref_table_name'"
);
}
}
}
=head2 reference_table
Get or set the table referred to by the constraint.
my $reference_table = $constraint->reference_table('foo');
=cut
has reference_table => ( is => 'rw', default => quote_sub(q{ '' }) );
=head2 table
Get or set the constraint's table object.
my $table = $field->table;
=cut
has table => ( is => 'rw', isa => schema_obj('Table'), weak_ref => 1 );
around table => \&ex2err;
=head2 type
Get or set the constraint's type.
my $type = $constraint->type( PRIMARY_KEY );
=cut
has type => (
is => 'rw',
default => quote_sub(q{ '' }),
coerce => quote_sub(q{ (my $t = $_[0]) =~ s/_/ /g; uc $t }),
isa => enum([keys %VALID_CONSTRAINT_TYPE], {
msg => "Invalid constraint type: %s", allow_false => 1,
}),
);
around type => \&ex2err;
=head2 equals
Determines if this constraint is the same as another
my $isIdentical = $constraint1->equals( $constraint2 );
=cut
around equals => sub {
my $orig = shift;
my $self = shift;
my $other = shift;
my $case_insensitive = shift;
my $ignore_constraint_names = shift;
return 0 unless $self->$orig($other);
return 0 unless $self->type eq $other->type;
unless ($ignore_constraint_names) {
return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
}
return 0 unless $self->deferrable eq $other->deferrable;
#return 0 unless $self->is_valid eq $other->is_valid;
return 0 unless $case_insensitive ? uc($self->table->name) eq uc($other->table->name)
: $self->table->name eq $other->table->name;
return 0 unless $self->expression eq $other->expression;
# Check fields, regardless of order
my %otherFields = (); # create a hash of the other fields
foreach my $otherField ($other->fields) {
$otherField = uc($otherField) if $case_insensitive;
$otherFields{$otherField} = 1;
}
foreach my $selfField ($self->fields) { # check for self fields in hash
$selfField = uc($selfField) if $case_insensitive;
return 0 unless $otherFields{$selfField};
delete $otherFields{$selfField};
}
# Check all other fields were accounted for
return 0 unless keys %otherFields == 0;
# Check reference fields, regardless of order
my %otherRefFields = (); # create a hash of the other reference fields
foreach my $otherRefField ($other->reference_fields) {
$otherRefField = uc($otherRefField) if $case_insensitive;
$otherRefFields{$otherRefField} = 1;
}
foreach my $selfRefField ($self->reference_fields) { # check for self reference fields in hash
$selfRefField = uc($selfRefField) if $case_insensitive;
return 0 unless $otherRefFields{$selfRefField};
delete $otherRefFields{$selfRefField};
}
# Check all other reference fields were accounted for
return 0 unless keys %otherRefFields == 0;
return 0 unless $case_insensitive ? uc($self->reference_table) eq uc($other->reference_table) : $self->reference_table eq $other->reference_table;
return 0 unless $self->match_type eq $other->match_type;
return 0 unless $self->on_delete eq $other->on_delete;
return 0 unless $self->on_update eq $other->on_update;
return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
return 1;
};
# Must come after all 'has' declarations
around new => \&ex2err;
1;
=pod
=head1 AUTHOR
Ken Youens-Clark Ekclark@cpan.orgE.
=cut
SQL-Translator-0.11018/lib/SQL/Translator/Schema/Trigger.pm 0000644 0001750 0001750 00000017373 12143357340 021656 0 ustar frew frew package SQL::Translator::Schema::Trigger;
=pod
=head1 NAME
SQL::Translator::Schema::Trigger - SQL::Translator trigger object
=head1 SYNOPSIS
use SQL::Translator::Schema::Trigger;
my $trigger = SQL::Translator::Schema::Trigger->new(
name => 'foo',
perform_action_when => 'before', # or after
database_events => [qw/update insert/], # also update, update_on, delete
fields => [], # if event is "update"
on_table => 'foo', # table name
action => '...', # text of trigger
schema => $schema, # Schema object
scope => 'row', # or statement
);
=head1 DESCRIPTION
C is the trigger object.
=head1 METHODS
=cut
use Moo;
use SQL::Translator::Utils qw(parse_list_arg ex2err throw);
use SQL::Translator::Types qw(schema_obj enum);
use List::MoreUtils qw(uniq);
use Sub::Quote qw(quote_sub);
extends 'SQL::Translator::Schema::Object';
our $VERSION = '1.59';
=head2 new
Object constructor.
my $schema = SQL::Translator::Schema::Trigger->new;
=cut
around BUILDARGS => sub {
my ($orig, $self, @args) = @_;
my $args = $self->$orig(@args);
if (exists $args->{on_table}) {
my $arg = delete $args->{on_table};
my $table = $args->{schema}->get_table($arg)
or die "Table named $arg doesn't exist";
$args->{table} = $table;
}
if (exists $args->{database_event}) {
$args->{database_events} = delete $args->{database_event};
}
return $args;
};
=head2 perform_action_when
Gets or sets whether the event happens "before" or "after" the
C.
$trigger->perform_action_when('after');
=cut
has perform_action_when => (
is => 'rw',
coerce => quote_sub(q{ defined $_[0] ? lc $_[0] : $_[0] }),
isa => enum([qw(before after)], {
msg => "Invalid argument '%s' to perform_action_when",
allow_undef => 1,
}),
);
around perform_action_when => \&ex2err;
sub database_event {
=pod
=head2 database_event
Obsolete please use database_events!
=cut
my $self = shift;
return $self->database_events( @_ );
}
=head2 database_events
Gets or sets the events that triggers the trigger.
my $ok = $trigger->database_events('insert');
=cut
has database_events => (
is => 'rw',
coerce => quote_sub(q{ [ map { lc } ref $_[0] eq 'ARRAY' ? @{$_[0]} : ($_[0]) ] }),
isa => sub {
my @args = @{$_[0]};
my %valid = map { $_, 1 } qw[ insert update update_on delete ];
my @invalid = grep { !defined $valid{ $_ } } @args;
if ( @invalid ) {
throw(
sprintf("Invalid events '%s' in database_events",
join(', ', @invalid)
)
);
}
},
);
around database_events => sub {
my ($orig,$self) = (shift, shift);
if (@_) {
ex2err($orig, $self, ref $_[0] eq 'ARRAY' ? $_[0] : \@_)
or return;
}
return wantarray
? @{ $self->$orig || [] }
: $self->$orig;
};
=head2 fields
Gets and set which fields to monitor for C.
$view->fields('id');
$view->fields('id', 'name');
$view->fields( 'id, name' );
$view->fields( [ 'id', 'name' ] );
$view->fields( qw[ id name ] );
my @fields = $view->fields;
=cut
has fields => (
is => 'rw',
coerce => sub {
my @fields = uniq @{parse_list_arg($_[0])};
@fields ? \@fields : undef;
},
);
around fields => sub {
my $orig = shift;
my $self = shift;
my $fields = parse_list_arg( @_ );
$self->$orig($fields) if @$fields;
return wantarray ? @{ $self->$orig || [] } : $self->$orig;
};
=head2 table
Gets or set the table on which the trigger works, as a L object.
$trigger->table($triggered_table);
=cut
has table => ( is => 'rw', isa => schema_obj('Table'), weak_ref => 1 );
around table => \&ex2err;
sub on_table {
=pod
=head2 on_table
Gets or set the table name on which the trigger works, as a string.
$trigger->on_table('foo');
=cut
my ($self, $arg) = @_;
if ( @_ == 2 ) {
my $table = $self->schema->get_table($arg);
die "Table named $arg doesn't exist"
if !$table;
$self->table($table);
}
return $self->table->name;
}
=head2 action
Gets or set the action of the trigger.
$trigger->action(
q[
BEGIN
select ...;
update ...;
END
]
);
=cut
has action => ( is => 'rw', default => quote_sub(q{ '' }) );
sub is_valid {
=pod
=head2 is_valid
Determine whether the trigger is valid or not.
my $ok = $trigger->is_valid;
=cut
my $self = shift;
for my $attr (
qw[ name perform_action_when database_events on_table action ]
) {
return $self->error("Invalid: missing '$attr'") unless $self->$attr();
}
return $self->error("Missing fields for UPDATE ON") if
$self->database_event eq 'update_on' && !$self->fields;
return 1;
}
=head2 name
Get or set the trigger's name.
my $name = $trigger->name('foo');
=cut
has name => ( is => 'rw', default => quote_sub(q{ '' }) );
=head2 order
Get or set the trigger's order.
my $order = $trigger->order(3);
=cut
has order => ( is => 'rw', default => quote_sub(q{ 0 }) );
around order => sub {
my ( $orig, $self, $arg ) = @_;
if ( defined $arg && $arg =~ /^\d+$/ ) {
return $self->$orig($arg);
}
return $self->$orig;
};
=head2 scope
Get or set the trigger's scope (row or statement).
my $scope = $trigger->scope('statement');
=cut
has scope => (
is => 'rw',
isa => enum([qw(row statement)], {
msg => "Invalid scope '%s'", icase => 1, allow_undef => 1,
}),
);
around scope => \&ex2err;
=head2 schema
Get or set the trigger's schema object.
$trigger->schema( $schema );
my $schema = $trigger->schema;
=cut
has schema => (is => 'rw', isa => schema_obj('Schema'), weak_ref => 1 );
around schema => \&ex2err;
sub compare_arrays {
=pod
=head2 compare_arrays
Compare two arrays.
=cut
my ($first, $second) = @_;
no warnings; # silence spurious -w undef complaints
return 0 unless (ref $first eq 'ARRAY' and ref $second eq 'ARRAY' ) ;
return 0 unless @$first == @$second;
my @first = sort @$first;
my @second = sort @$second;
for (my $i = 0; $i < scalar @first; $i++) {
return 0 if @first[$i] ne @second[$i];
}
return 1;
}
=head2 equals
Determines if this trigger is the same as another
my $is_identical = $trigger1->equals( $trigger2 );
=cut
around equals => sub {
my $orig = shift;
my $self = shift;
my $other = shift;
my $case_insensitive = shift;
return 0 unless $self->$orig($other);
my %names;
for my $name ( $self->name, $other->name ) {
$name = lc $name if $case_insensitive;
$names{ $name }++;
}
if ( keys %names > 1 ) {
return $self->error('Names not equal');
}
if ( !$self->perform_action_when eq $other->perform_action_when ) {
return $self->error('perform_action_when differs');
}
if (
!compare_arrays( [$self->database_events], [$other->database_events] )
) {
return $self->error('database_events differ');
}
if ( $self->on_table ne $other->on_table ) {
return $self->error('on_table differs');
}
if ( $self->action ne $other->action ) {
return $self->error('action differs');
}
if (
!$self->_compare_objects( scalar $self->extra, scalar $other->extra )
) {
return $self->error('extras differ');
}
return 1;
};
# Must come after all 'has' declarations
around new => \&ex2err;
1;
=pod
=head1 AUTHORS
Anonymous,
Ken Youens-Clark Ekclark@cpan.orgE.
=cut
SQL-Translator-0.11018/lib/SQL/Translator/Schema/Constants.pm 0000644 0001750 0001750 00000002214 12143357340 022213 0 ustar frew frew package SQL::Translator::Schema::Constants;
=head1 NAME
SQL::Translator::Schema::Constants - constants module
=head1 SYNOPSIS
use SQL::Translator::Schema::Constants;
$table->add_constraint(
name => 'foo',
type => PRIMARY_KEY,
);
=head1 DESCRIPTION
This module exports the following constants for Schema features;
=over 4
=item CHECK_C
=item FOREIGN_KEY
=item FULL_TEXT
=item NOT_NULL
=item NORMAL
=item NULL
=item PRIMARY_KEY
=item UNIQUE
=back
=cut
use strict;
use warnings;
use base qw( Exporter );
require Exporter;
our $VERSION = '1.59';
our @EXPORT = qw[
CHECK_C
FOREIGN_KEY
FULL_TEXT
SPATIAL
NOT_NULL
NORMAL
NULL
PRIMARY_KEY
UNIQUE
];
#
# Because "CHECK" is a Perl keyword
#
use constant CHECK_C => 'CHECK';
use constant FOREIGN_KEY => 'FOREIGN KEY';
use constant FULL_TEXT => 'FULLTEXT';
use constant SPATIAL => 'SPATIAL';
use constant NOT_NULL => 'NOT NULL';
use constant NORMAL => 'NORMAL';
use constant NULL => 'NULL';
use constant PRIMARY_KEY => 'PRIMARY KEY';
use constant UNIQUE => 'UNIQUE';
1;
=pod
=head1 AUTHOR
Ken Youens-Clark Ekclark@cpan.orgE.
=cut
SQL-Translator-0.11018/lib/SQL/Translator/Schema/View.pm 0000644 0001750 0001750 00000010411 12234455220 021144 0 ustar frew frew package SQL::Translator::Schema::View;
=pod
=head1 NAME
SQL::Translator::Schema::View - SQL::Translator view object
=head1 SYNOPSIS
use SQL::Translator::Schema::View;
my $view = SQL::Translator::Schema::View->new(
name => 'foo', # name, required
sql => 'select id, name from foo', # SQL for view
fields => 'id, name', # field names in view
);
=head1 DESCRIPTION
C is the view object.
=head1 METHODS
=cut
use Moo;
use SQL::Translator::Utils qw(ex2err);
use SQL::Translator::Types qw(schema_obj);
use SQL::Translator::Role::ListAttr;
use Sub::Quote qw(quote_sub);
extends 'SQL::Translator::Schema::Object';
our $VERSION = '1.59';
=head2 new
Object constructor.
my $view = SQL::Translator::Schema::View->new;
=head2 fields
Gets and set the fields the constraint is on. Accepts a string, list or
arrayref; returns an array or array reference. Will unique the field
names and keep them in order by the first occurrence of a field name.
$view->fields('id');
$view->fields('id', 'name');
$view->fields( 'id, name' );
$view->fields( [ 'id', 'name' ] );
$view->fields( qw[ id name ] );
my @fields = $view->fields;
=cut
with ListAttr fields => ( uniq => 1 );
=head2 tables
Gets and set the tables the SELECT mentions. Accepts a string, list or
arrayref; returns an array or array reference. Will unique the table
names and keep them in order by the first occurrence of a field name.
$view->tables('foo');
$view->tables('foo', 'bar');
$view->tables( 'foo, bar' );
$view->tables( [ 'foo', 'bar' ] );
$view->tables( qw[ foo bar ] );
my @tables = $view->tables;
=cut
with ListAttr tables => ( uniq => 1 );
=head2 options
Gets or appends a list of options on the view.
$view->options('ALGORITHM=UNDEFINED');
my @options = $view->options;
=cut
with ListAttr options => ( uniq => 1, append => 1 );
sub is_valid {
=pod
=head2 is_valid
Determine whether the view is valid or not.
my $ok = $view->is_valid;
=cut
my $self = shift;
return $self->error('No name') unless $self->name;
return $self->error('No sql') unless $self->sql;
return 1;
}
=head2 name
Get or set the view's name.
my $name = $view->name('foo');
=cut
has name => ( is => 'rw', default => quote_sub(q{ '' }) );
=head2 order
Get or set the view's order.
my $order = $view->order(3);
=cut
has order => ( is => 'rw', default => quote_sub(q{ 0 }) );
around order => sub {
my ( $orig, $self, $arg ) = @_;
if ( defined $arg && $arg =~ /^\d+$/ ) {
return $self->$orig($arg);
}
return $self->$orig;
};
=head2 sql
Get or set the view's SQL.
my $sql = $view->sql('select * from foo');
=cut
has sql => ( is => 'rw', default => quote_sub(q{ '' }) );
=head2 schema
Get or set the view's schema object.
$view->schema( $schema );
my $schema = $view->schema;
=cut
has schema => ( is => 'rw', isa => schema_obj('Schema'), weak_ref => 1 );
around schema => \&ex2err;
=head2 equals
Determines if this view is the same as another
my $isIdentical = $view1->equals( $view2 );
=cut
around equals => sub {
my $orig = shift;
my $self = shift;
my $other = shift;
my $case_insensitive = shift;
my $ignore_sql = shift;
return 0 unless $self->$orig($other);
return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
#return 0 unless $self->is_valid eq $other->is_valid;
unless ($ignore_sql) {
my $selfSql = $self->sql;
my $otherSql = $other->sql;
# Remove comments
$selfSql =~ s/--.*$//mg;
$otherSql =~ s/--.*$//mg;
# Collapse whitespace to space to avoid whitespace comparison issues
$selfSql =~ s/\s+/ /sg;
$otherSql =~ s/\s+/ /sg;
return 0 unless $selfSql eq $otherSql;
}
my $selfFields = join(":", $self->fields);
my $otherFields = join(":", $other->fields);
return 0 unless $case_insensitive ? uc($selfFields) eq uc($otherFields) : $selfFields eq $otherFields;
return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
return 1;
};
# Must come after all 'has' declarations
around new => \&ex2err;
1;
=pod
=head1 AUTHOR
Ken Youens-Clark Ekclark@cpan.orgE.
=cut
SQL-Translator-0.11018/lib/SQL/Translator/Schema/Table.pm 0000644 0001750 0001750 00000063041 12234455220 021270 0 ustar frew frew package SQL::Translator::Schema::Table;
=pod
=head1 NAME
SQL::Translator::Schema::Table - SQL::Translator table object
=head1 SYNOPSIS
use SQL::Translator::Schema::Table;
my $table = SQL::Translator::Schema::Table->new( name => 'foo' );
=head1 DESCRIPTION
C is the table object.
=head1 METHODS
=cut
use Moo;
use SQL::Translator::Utils qw(parse_list_arg ex2err throw carp_ro);
use SQL::Translator::Types qw(schema_obj);
use SQL::Translator::Role::ListAttr;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Schema::Constraint;
use SQL::Translator::Schema::Field;
use SQL::Translator::Schema::Index;
use Carp::Clan '^SQL::Translator';
use List::Util 'max';
use Sub::Quote qw(quote_sub);
extends 'SQL::Translator::Schema::Object';
our $VERSION = '1.59';
# Stringify to our name, being careful not to pass any args through so we don't
# accidentally set it to undef. We also have to tweak bool so the object is
# still true when it doesn't have a name (which shouldn't happen!).
use overload
'""' => sub { shift->name },
'bool' => sub { $_[0]->name || $_[0] },
fallback => 1,
;
=pod
=head2 new
Object constructor.
my $table = SQL::Translator::Schema::Table->new(
schema => $schema,
name => 'foo',
);
=head2 add_constraint
Add a constraint to the table. Returns the newly created
C object.
my $c1 = $table->add_constraint(
name => 'pk',
type => PRIMARY_KEY,
fields => [ 'foo_id' ],
);
my $c2 = SQL::Translator::Schema::Constraint->new( name => 'uniq' );
$c2 = $table->add_constraint( $constraint );
=cut
has _constraints => (
is => 'ro',
init_arg => undef,
default => quote_sub(q{ +[] }),
predicate => 1,
lazy => 1,
);
sub add_constraint {
my $self = shift;
my $constraint_class = 'SQL::Translator::Schema::Constraint';
my $constraint;
if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) {
$constraint = shift;
$constraint->table( $self );
}
else {
my %args = @_;
$args{'table'} = $self;
$constraint = $constraint_class->new( \%args ) or
return $self->error( $constraint_class->error );
}
#
# If we're trying to add a PK when one is already defined,
# then just add the fields to the existing definition.
#
my $ok = 1;
my $pk = $self->primary_key;
if ( $pk && $constraint->type eq PRIMARY_KEY ) {
$self->primary_key( $constraint->fields );
$pk->name($constraint->name) if $constraint->name;
my %extra = $constraint->extra;
$pk->extra(%extra) if keys %extra;
$constraint = $pk;
$ok = 0;
}
elsif ( $constraint->type eq PRIMARY_KEY ) {
for my $fname ( $constraint->fields ) {
if ( my $f = $self->get_field( $fname ) ) {
$f->is_primary_key( 1 );
}
}
}
#
# See if another constraint of the same type
# covers the same fields. -- This doesn't work! ky
#
# elsif ( $constraint->type ne CHECK_C ) {
# my @field_names = $constraint->fields;
# for my $c (
# grep { $_->type eq $constraint->type }
# $self->get_constraints
# ) {
# my %fields = map { $_, 1 } $c->fields;
# for my $field_name ( @field_names ) {
# if ( $fields{ $field_name } ) {
# $constraint = $c;
# $ok = 0;
# last;
# }
# }
# last unless $ok;
# }
# }
if ( $ok ) {
push @{ $self->_constraints }, $constraint;
}
return $constraint;
}
=head2 drop_constraint
Remove a constraint from the table. Returns the constraint object if the index
was found and removed, an error otherwise. The single parameter can be either
an index name or an C object.
$table->drop_constraint('myconstraint');
=cut
sub drop_constraint {
my $self = shift;
my $constraint_class = 'SQL::Translator::Schema::Constraint';
my $constraint_name;
if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) {
$constraint_name = shift->name;
}
else {
$constraint_name = shift;
}
if ( ! ($self->_has_constraints && grep { $_->name eq $constraint_name } @ { $self->_constraints }) ) {
return $self->error(qq[Can't drop constraint: "$constraint_name" doesn't exist]);
}
my @cs = @{ $self->_constraints };
my ($constraint_id) = grep { $cs[$_]->name eq $constraint_name } (0..$#cs);
my $constraint = splice(@{$self->_constraints}, $constraint_id, 1);
return $constraint;
}
=head2 add_index
Add an index to the table. Returns the newly created
C object.
my $i1 = $table->add_index(
name => 'name',
fields => [ 'name' ],
type => 'normal',
);
my $i2 = SQL::Translator::Schema::Index->new( name => 'id' );
$i2 = $table->add_index( $index );
=cut
has _indices => (
is => 'ro',
init_arg => undef,
default => quote_sub(q{ [] }),
predicate => 1,
lazy => 1,
);
sub add_index {
my $self = shift;
my $index_class = 'SQL::Translator::Schema::Index';
my $index;
if ( UNIVERSAL::isa( $_[0], $index_class ) ) {
$index = shift;
$index->table( $self );
}
else {
my %args = @_;
$args{'table'} = $self;
$index = $index_class->new( \%args ) or return
$self->error( $index_class->error );
}
foreach my $ex_index ($self->get_indices) {
return if ($ex_index->equals($index));
}
push @{ $self->_indices }, $index;
return $index;
}
=head2 drop_index
Remove an index from the table. Returns the index object if the index was
found and removed, an error otherwise. The single parameter can be either
an index name of an C object.
$table->drop_index('myindex');
=cut
sub drop_index {
my $self = shift;
my $index_class = 'SQL::Translator::Schema::Index';
my $index_name;
if ( UNIVERSAL::isa( $_[0], $index_class ) ) {
$index_name = shift->name;
}
else {
$index_name = shift;
}
if ( ! ($self->_has_indices && grep { $_->name eq $index_name } @{ $self->_indices }) ) {
return $self->error(qq[Can't drop index: "$index_name" doesn't exist]);
}
my @is = @{ $self->_indices };
my ($index_id) = grep { $is[$_]->name eq $index_name } (0..$#is);
my $index = splice(@{$self->_indices}, $index_id, 1);
return $index;
}
=head2 add_field
Add an field to the table. Returns the newly created
C object. The "name" parameter is
required. If you try to create a field with the same name as an
existing field, you will get an error and the field will not be created.
my $f1 = $table->add_field(
name => 'foo_id',
data_type => 'integer',
size => 11,
);
my $f2 = SQL::Translator::Schema::Field->new(
name => 'name',
table => $table,
);
$f2 = $table->add_field( $field2 ) or die $table->error;
=cut
has _fields => (
is => 'ro',
init_arg => undef,
default => quote_sub(q{ +{} }),
predicate => 1,
lazy => 1
);
sub add_field {
my $self = shift;
my $field_class = 'SQL::Translator::Schema::Field';
my $field;
if ( UNIVERSAL::isa( $_[0], $field_class ) ) {
$field = shift;
$field->table( $self );
}
else {
my %args = @_;
$args{'table'} = $self;
$field = $field_class->new( \%args ) or return
$self->error( $field_class->error );
}
my $existing_order = { map { $_->order => $_->name } $self->get_fields };
# supplied order, possible unordered assembly
if ( $field->order ) {
if($existing_order->{$field->order}) {
croak sprintf
"Requested order '%d' for column '%s' conflicts with already existing column '%s'",
$field->order,
$field->name,
$existing_order->{$field->order},
;
}
}
else {
my $last_field_no = max(keys %$existing_order) || 0;
if ( $last_field_no != scalar keys %$existing_order ) {
croak sprintf
"Table '%s' field order incomplete - unable to auto-determine order for newly added field",
$self->name,
;
}
$field->order( $last_field_no + 1 );
}
# We know we have a name as the Field->new above errors if none given.
my $field_name = $field->name;
if ( $self->get_field($field_name) ) {
return $self->error(qq[Can't use field name "$field_name": field exists]);
}
else {
$self->_fields->{ $field_name } = $field;
}
return $field;
}
=head2 drop_field
Remove a field from the table. Returns the field object if the field was
found and removed, an error otherwise. The single parameter can be either
a field name or an C object.
$table->drop_field('myfield');
=cut
sub drop_field {
my $self = shift;
my $field_class = 'SQL::Translator::Schema::Field';
my $field_name;
if ( UNIVERSAL::isa( $_[0], $field_class ) ) {
$field_name = shift->name;
}
else {
$field_name = shift;
}
my %args = @_;
my $cascade = $args{'cascade'};
if ( ! ($self->_has_fields && exists $self->_fields->{ $field_name } ) ) {
return $self->error(qq[Can't drop field: "$field_name" doesn't exists]);
}
my $field = delete $self->_fields->{ $field_name };
if ( $cascade ) {
# Remove this field from all indices using it
foreach my $i ($self->get_indices()) {
my @fs = $i->fields();
@fs = grep { $_ ne $field->name } @fs;
$i->fields(@fs);
}
# Remove this field from all constraints using it
foreach my $c ($self->get_constraints()) {
my @cs = $c->fields();
@cs = grep { $_ ne $field->name } @cs;
$c->fields(@cs);
}
}
return $field;
}
=head2 comments
Get or set the comments on a table. May be called several times to
set and it will accumulate the comments. Called in an array context,
returns each comment individually; called in a scalar context, returns
all the comments joined on newlines.
$table->comments('foo');
$table->comments('bar');
print join( ', ', $table->comments ); # prints "foo, bar"
=cut
has comments => (
is => 'rw',
coerce => quote_sub(q{ ref($_[0]) eq 'ARRAY' ? $_[0] : [$_[0]] }),
default => quote_sub(q{ [] }),
);
around comments => sub {
my $orig = shift;
my $self = shift;
my @comments = ref $_[0] ? @{ $_[0] } : @_;
for my $arg ( @comments ) {
$arg = $arg->[0] if ref $arg;
push @{ $self->$orig }, $arg if defined $arg && $arg;
}
@comments = @{$self->$orig};
return wantarray ? @comments
: @comments ? join( "\n", @comments )
: undef;
};
=head2 get_constraints
Returns all the constraint objects as an array or array reference.
my @constraints = $table->get_constraints;
=cut
sub get_constraints {
my $self = shift;
if ( $self->_has_constraints ) {
return wantarray
? @{ $self->_constraints } : $self->_constraints;
}
else {
$self->error('No constraints');
return;
}
}
=head2 get_indices
Returns all the index objects as an array or array reference.
my @indices = $table->get_indices;
=cut
sub get_indices {
my $self = shift;
if ( $self->_has_indices ) {
return wantarray
? @{ $self->_indices }
: $self->_indices;
}
else {
$self->error('No indices');
return;
}
}
=head2 get_field
Returns a field by the name provided.
my $field = $table->get_field('foo');
=cut
sub get_field {
my $self = shift;
my $field_name = shift or return $self->error('No field name');
my $case_insensitive = shift;
return $self->error(qq[Field "$field_name" does not exist])
unless $self->_has_fields;
if ( $case_insensitive ) {
$field_name = uc($field_name);
foreach my $field ( keys %{$self->_fields} ) {
return $self->_fields->{$field} if $field_name eq uc($field);
}
return $self->error(qq[Field "$field_name" does not exist]);
}
return $self->error( qq[Field "$field_name" does not exist] ) unless
exists $self->_fields->{ $field_name };
return $self->_fields->{ $field_name };
}
=head2 get_fields
Returns all the field objects as an array or array reference.
my @fields = $table->get_fields;
=cut
sub get_fields {
my $self = shift;
my @fields =
map { $_->[1] }
sort { $a->[0] <=> $b->[0] }
map { [ $_->order, $_ ] }
values %{ $self->_has_fields ? $self->_fields : {} };
if ( @fields ) {
return wantarray ? @fields : \@fields;
}
else {
$self->error('No fields');
return;
}
}
=head2 is_valid
Determine whether the view is valid or not.
my $ok = $view->is_valid;
=cut
sub is_valid {
my $self = shift;
return $self->error('No name') unless $self->name;
return $self->error('No fields') unless $self->get_fields;
for my $object (
$self->get_fields, $self->get_indices, $self->get_constraints
) {
return $object->error unless $object->is_valid;
}
return 1;
}
=head2 is_trivial_link
True if table has no data (non-key) fields and only uses single key joins.
=cut
has is_trivial_link => ( is => 'lazy', init_arg => undef );
around is_trivial_link => carp_ro('is_trivial_link');
sub _build_is_trivial_link {
my $self = shift;
return 0 if $self->is_data;
my %fk = ();
foreach my $field ( $self->get_fields ) {
next unless $field->is_foreign_key;
$fk{$field->foreign_key_reference->reference_table}++;
}
foreach my $referenced (keys %fk){
if($fk{$referenced} > 1){
return 0;
}
}
return 1;
}
=head2 is_data
Returns true if the table has some non-key fields.
=cut
has is_data => ( is => 'lazy', init_arg => undef );
around is_data => carp_ro('is_data');
sub _build_is_data {
my $self = shift;
foreach my $field ( $self->get_fields ) {
if ( !$field->is_primary_key and !$field->is_foreign_key ) {
return 1;
}
}
return 0;
}
=head2 can_link
Determine whether the table can link two arg tables via many-to-many.
my $ok = $table->can_link($table1,$table2);
=cut
has _can_link => ( is => 'ro', init_arg => undef, default => quote_sub(q{ +{} }) );
sub can_link {
my ( $self, $table1, $table2 ) = @_;
return $self->_can_link->{ $table1->name }{ $table2->name }
if defined $self->_can_link->{ $table1->name }{ $table2->name };
if ( $self->is_data == 1 ) {
$self->_can_link->{ $table1->name }{ $table2->name } = [0];
$self->_can_link->{ $table2->name }{ $table1->name } = [0];
return $self->_can_link->{ $table1->name }{ $table2->name };
}
my %fk = ();
foreach my $field ( $self->get_fields ) {
if ( $field->is_foreign_key ) {
push @{ $fk{ $field->foreign_key_reference->reference_table } },
$field->foreign_key_reference;
}
}
if ( !defined( $fk{ $table1->name } ) or !defined( $fk{ $table2->name } ) )
{
$self->_can_link->{ $table1->name }{ $table2->name } = [0];
$self->_can_link->{ $table2->name }{ $table1->name } = [0];
return $self->_can_link->{ $table1->name }{ $table2->name };
}
# trivial traversal, only one way to link the two tables
if ( scalar( @{ $fk{ $table1->name } } == 1 )
and scalar( @{ $fk{ $table2->name } } == 1 ) )
{
$self->_can_link->{ $table1->name }{ $table2->name } =
[ 'one2one', $fk{ $table1->name }, $fk{ $table2->name } ];
$self->_can_link->{ $table1->name }{ $table2->name } =
[ 'one2one', $fk{ $table2->name }, $fk{ $table1->name } ];
# non-trivial traversal. one way to link table2,
# many ways to link table1
}
elsif ( scalar( @{ $fk{ $table1->name } } > 1 )
and scalar( @{ $fk{ $table2->name } } == 1 ) )
{
$self->_can_link->{ $table1->name }{ $table2->name } =
[ 'many2one', $fk{ $table1->name }, $fk{ $table2->name } ];
$self->_can_link->{ $table2->name }{ $table1->name } =
[ 'one2many', $fk{ $table2->name }, $fk{ $table1->name } ];
# non-trivial traversal. one way to link table1,
# many ways to link table2
}
elsif ( scalar( @{ $fk{ $table1->name } } == 1 )
and scalar( @{ $fk{ $table2->name } } > 1 ) )
{
$self->_can_link->{ $table1->name }{ $table2->name } =
[ 'one2many', $fk{ $table1->name }, $fk{ $table2->name } ];
$self->_can_link->{ $table2->name }{ $table1->name } =
[ 'many2one', $fk{ $table2->name }, $fk{ $table1->name } ];
# non-trivial traversal. many ways to link table1 and table2
}
elsif ( scalar( @{ $fk{ $table1->name } } > 1 )
and scalar( @{ $fk{ $table2->name } } > 1 ) )
{
$self->_can_link->{ $table1->name }{ $table2->name } =
[ 'many2many', $fk{ $table1->name }, $fk{ $table2->name } ];
$self->_can_link->{ $table2->name }{ $table1->name } =
[ 'many2many', $fk{ $table2->name }, $fk{ $table1->name } ];
# one of the tables didn't export a key
# to this table, no linking possible
}
else {
$self->_can_link->{ $table1->name }{ $table2->name } = [0];
$self->_can_link->{ $table2->name }{ $table1->name } = [0];
}
return $self->_can_link->{ $table1->name }{ $table2->name };
}
=head2 name
Get or set the table's name.
Errors ("No table name") if you try to set a blank name.
If provided an argument, checks the schema object for a table of
that name and disallows the change if one exists (setting the error to
"Can't use table name "%s": table exists").
my $table_name = $table->name('foo');
=cut
has name => (
is => 'rw',
isa => sub { throw("No table name") unless $_[0] },
);
around name => sub {
my $orig = shift;
my $self = shift;
if ( my ($arg) = @_ ) {
if ( my $schema = $self->schema ) {
return $self->error( qq[Can't use table name "$arg": table exists] )
if $schema->get_table( $arg );
}
}
return ex2err($orig, $self, @_);
};
=head2 schema
Get or set the table's schema object.
my $schema = $table->schema;
=cut
has schema => ( is => 'rw', isa => schema_obj('Schema'), weak_ref => 1 );
around schema => \&ex2err;
sub primary_key {
=pod
=head2 primary_key
Gets or sets the table's primary key(s). Takes one or more field
names (as a string, list or array[ref]) as an argument. If the field
names are present, it will create a new PK if none exists, or it will
add to the fields of an existing PK (and will unique the field names).
Returns the C object representing
the primary key.
These are equivalent:
$table->primary_key('id');
$table->primary_key(['name']);
$table->primary_key('id','name']);
$table->primary_key(['id','name']);
$table->primary_key('id,name');
$table->primary_key(qw[ id name ]);
my $pk = $table->primary_key;
=cut
my $self = shift;
my $fields = parse_list_arg( @_ );
my $constraint;
if ( @$fields ) {
for my $f ( @$fields ) {
return $self->error(qq[Invalid field "$f"]) unless
$self->get_field($f);
}
my $has_pk;
for my $c ( $self->get_constraints ) {
if ( $c->type eq PRIMARY_KEY ) {
$has_pk = 1;
$c->fields( @{ $c->fields }, @$fields );
$constraint = $c;
}
}
unless ( $has_pk ) {
$constraint = $self->add_constraint(
type => PRIMARY_KEY,
fields => $fields,
) or return;
}
}
if ( $constraint ) {
return $constraint;
}
else {
for my $c ( $self->get_constraints ) {
return $c if $c->type eq PRIMARY_KEY;
}
}
return;
}
=head2 options
Get or append to the table's options (e.g., table types for MySQL).
Returns an array or array reference.
my @options = $table->options;
=cut
with ListAttr options => ( append => 1 );
=head2 order
Get or set the table's order.
my $order = $table->order(3);
=cut
has order => ( is => 'rw', default => quote_sub(q{ 0 }) );
around order => sub {
my ( $orig, $self, $arg ) = @_;
if ( defined $arg && $arg =~ /^\d+$/ ) {
return $self->$orig($arg);
}
return $self->$orig;
};
=head2 field_names
Read-only method to return a list or array ref of the field names. Returns undef
or an empty list if the table has no fields set. Useful if you want to
avoid the overload magic of the Field objects returned by the get_fields method.
my @names = $constraint->field_names;
=cut
sub field_names {
my $self = shift;
my @fields =
map { $_->name }
$self->get_fields;
if ( @fields ) {
return wantarray ? @fields : \@fields;
}
else {
$self->error('No fields');
return;
}
}
sub equals {
=pod
=head2 equals
Determines if this table is the same as another
my $isIdentical = $table1->equals( $table2 );
=cut
my $self = shift;
my $other = shift;
my $case_insensitive = shift;
return 0 unless $self->SUPER::equals($other);
return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
# Fields
# Go through our fields
my %checkedFields;
foreach my $field ( $self->get_fields ) {
my $otherField = $other->get_field($field->name, $case_insensitive);
return 0 unless $field->equals($otherField, $case_insensitive);
$checkedFields{$field->name} = 1;
}
# Go through the other table's fields
foreach my $otherField ( $other->get_fields ) {
next if $checkedFields{$otherField->name};
return 0;
}
# Constraints
# Go through our constraints
my %checkedConstraints;
CONSTRAINT:
foreach my $constraint ( $self->get_constraints ) {
foreach my $otherConstraint ( $other->get_constraints ) {
if ( $constraint->equals($otherConstraint, $case_insensitive) ) {
$checkedConstraints{$otherConstraint} = 1;
next CONSTRAINT;
}
}
return 0;
}
# Go through the other table's constraints
CONSTRAINT2:
foreach my $otherConstraint ( $other->get_constraints ) {
next if $checkedFields{$otherConstraint};
foreach my $constraint ( $self->get_constraints ) {
if ( $otherConstraint->equals($constraint, $case_insensitive) ) {
next CONSTRAINT2;
}
}
return 0;
}
# Indices
# Go through our indices
my %checkedIndices;
INDEX:
foreach my $index ( $self->get_indices ) {
foreach my $otherIndex ( $other->get_indices ) {
if ( $index->equals($otherIndex, $case_insensitive) ) {
$checkedIndices{$otherIndex} = 1;
next INDEX;
}
}
return 0;
}
# Go through the other table's indices
INDEX2:
foreach my $otherIndex ( $other->get_indices ) {
next if $checkedIndices{$otherIndex};
foreach my $index ( $self->get_indices ) {
if ( $otherIndex->equals($index, $case_insensitive) ) {
next INDEX2;
}
}
return 0;
}
return 1;
}
=head1 LOOKUP METHODS
The following are a set of shortcut methods for getting commonly used lists of
fields and constraints. They all return lists or array refs of Field or
Constraint objects.
=over 4
=item pkey_fields
The primary key fields.
=item fkey_fields
All foreign key fields.
=item nonpkey_fields
All the fields except the primary key.
=item data_fields
All non key fields.
=item unique_fields
All fields with unique constraints.
=item unique_constraints
All this tables unique constraints.
=item fkey_constraints
All this tables foreign key constraints. (See primary_key method to get the
primary key constraint)
=back
=cut
sub pkey_fields {
my $me = shift;
my @fields = grep { $_->is_primary_key } $me->get_fields;
return wantarray ? @fields : \@fields;
}
sub fkey_fields {
my $me = shift;
my @fields;
push @fields, $_->fields foreach $me->fkey_constraints;
return wantarray ? @fields : \@fields;
}
sub nonpkey_fields {
my $me = shift;
my @fields = grep { !$_->is_primary_key } $me->get_fields;
return wantarray ? @fields : \@fields;
}
sub data_fields {
my $me = shift;
my @fields =
grep { !$_->is_foreign_key and !$_->is_primary_key } $me->get_fields;
return wantarray ? @fields : \@fields;
}
sub unique_fields {
my $me = shift;
my @fields;
push @fields, $_->fields foreach $me->unique_constraints;
return wantarray ? @fields : \@fields;
}
sub unique_constraints {
my $me = shift;
my @cons = grep { $_->type eq UNIQUE } $me->get_constraints;
return wantarray ? @cons : \@cons;
}
sub fkey_constraints {
my $me = shift;
my @cons = grep { $_->type eq FOREIGN_KEY } $me->get_constraints;
return wantarray ? @cons : \@cons;
}
# Must come after all 'has' declarations
around new => \&ex2err;
1;
=pod
=head1 AUTHORS
Ken Youens-Clark Ekclark@cpan.orgE,
Allen Day Eallenday@ucla.eduE.
=cut
SQL-Translator-0.11018/lib/SQL/Translator/Role/ 0000755 0001750 0001750 00000000000 12234461403 017400 5 ustar frew frew SQL-Translator-0.11018/lib/SQL/Translator/Role/ListAttr.pm 0000644 0001750 0001750 00000005624 12234455220 021513 0 ustar frew frew package SQL::Translator::Role::ListAttr;
=head1 NAME
SQL::Translator::Role::ListAttr - context-sensitive list attributes
=head1 SYNOPSIS
package Foo;
use Moo;
use SQL::Translator::Role::ListAttr;
with ListAttr foo => ( uniq => 1, append => 1 );
=head1 DESCRIPTION
This package provides a variable L for context-sensitive list
attributes.
=cut
use strictures 1;
use SQL::Translator::Utils qw(parse_list_arg ex2err);
use List::MoreUtils qw(uniq);
use Sub::Quote qw(quote_sub);
use Package::Variant (
importing => {
'Moo::Role' => [],
},
subs => [qw(has around)],
);
=head1 FUNCTIONS
=head2 ListAttr $name => %parameters;
Returns a L providing an arrayref attribute named C<$name>,
and wrapping the accessor to provide context-sensitivity both for
setting and getting. If no C or C is provided, the
default value is the empty list.
On setting, the arguments are parsed using
L, and the accessor will return
an array reference or a list, depending on context.
=head3 Parameters
=over
=item append
If true, the setter will append arguments to the existing ones, rather
than replacing them.
=item uniq
If true, duplicate items will be removed, keeping the first one seen.
=item may_throw
If accessing the attribute might L
an exception (e.g. from a C or C check), this should be
set to make the accessor store the exception using
L and return undef.
=item undef_if_empty
If true, and the list is empty, the accessor will return C
instead of a reference to an empty in scalar context.
=back
Unknown parameters are passed through to the L call for
the attribute.
=cut
sub make_variant {
my ($class, $target_package, $name, %arguments) = @_;
my $may_throw = delete $arguments{may_throw};
my $undef_if_empty = delete $arguments{undef_if_empty};
my $append = delete $arguments{append};
my $coerce = delete $arguments{uniq}
? sub { [ uniq @{parse_list_arg($_[0])} ] }
: \&parse_list_arg;
has($name => (
is => 'rw',
(!$arguments{builder} ? (
default => quote_sub(q{ [] }),
) : ()),
coerce => $coerce,
%arguments,
));
around($name => sub {
my ($orig, $self) = (shift, shift);
my $list = parse_list_arg(@_);
$self->$orig([ @{$append ? $self->$orig : []}, @$list ])
if @$list;
my $return;
if ($may_throw) {
$return = ex2err($orig, $self) or return;
}
else {
$return = $self->$orig;
}
my $scalar_return = !@{$return} && $undef_if_empty ? undef : $return;
return wantarray ? @{$return} : $scalar_return;
});
}
=head1 SEE ALSO
=over
=item L
=item L
=back
=cut
1;
SQL-Translator-0.11018/lib/SQL/Translator/Role/Debug.pm 0000644 0001750 0001750 00000001457 12143357340 020776 0 ustar frew frew package SQL::Translator::Role::Debug;
use Moo::Role;
use Sub::Quote qw(quote_sub);
has _DEBUG => (
is => 'rw',
accessor => 'debugging',
init_arg => 'debugging',
coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
lazy => 1,
builder => 1,
);
sub _build__DEBUG {
my ($self) = @_;
my $class = ref $self;
no strict 'refs';
return ${"${class}::DEBUG"};
}
around debugging => sub {
my ($orig, $self) = (shift, shift);
# Emulate horrible Class::Base API
unless (ref $self) {
my $dbgref = do { no strict 'refs'; \${"${self}::DEBUG"} };
$$dbgref = $_[0] if @_;
return $$dbgref;
}
return $self->$orig(@_);
};
sub debug {
my $self = shift;
return unless $self->debugging;
print STDERR '[', (ref $self || $self), '] ', @_, "\n";
}
1;
SQL-Translator-0.11018/lib/SQL/Translator/Role/BuildArgs.pm 0000644 0001750 0001750 00000001243 12143357340 021615 0 ustar frew frew package SQL::Translator::Role::BuildArgs;
=head1 NAME
SQL::Translator::Role::BuildArgs - Remove undefined constructor arguments
=head1 SYNOPSIS
package Foo;
use Moo;
with qw(SQL::Translator::Role::BuildArgs);
=head1 DESCRIPTION
This L wraps BUILDARGS to remove C constructor
arguments for backwards compatibility with the old L-based
L.
=cut
use Moo::Role;
around BUILDARGS => sub {
my $orig = shift;
my $self = shift;
my $args = $self->$orig(@_);
foreach my $arg (keys %{$args}) {
delete $args->{$arg} unless defined($args->{$arg});
}
return $args;
};
1;
SQL-Translator-0.11018/lib/SQL/Translator/Role/Error.pm 0000644 0001750 0001750 00000003041 12143357340 021030 0 ustar frew frew package SQL::Translator::Role::Error;
=head1 NAME
SQL::Translator::Role::Error - Error setter/getter for objects and classes
=head1 SYNOPSIS
In the class consuming the role:
package Foo;
use Moo;
with qw(SQL::Translator::Role::Error);
sub foo {
...
return $self->error("Something failed")
unless $some_condition;
...
}
In code using the class:
Foo->foo or die Foo->error;
# or
$foo->foo or die $foo->error;
=head1 DESCRIPTION
This L provides a method for getting and setting error on a
class or object.
=cut
use Moo::Role;
use Sub::Quote qw(quote_sub);
has _ERROR => (
is => 'rw',
accessor => 'error',
init_arg => undef,
default => quote_sub(q{ '' }),
);
=head1 METHODS
=head2 $object_or_class->error([$message])
If called with an argument, sets the error message and returns undef,
otherwise returns the message.
As an implementation detail, for compatibility with L, the
message is stored in C<< $object->{_ERROR} >> or C<< $Class::ERROR >>,
depending on whether the invocant is an object.
=cut
around error => sub {
my ($orig, $self) = (shift, shift);
# Emulate horrible Class::Base API
unless (ref($self)) {
my $errref = do { no strict 'refs'; \${"${self}::ERROR"} };
return $$errref unless @_;
$$errref = $_[0];
return undef;
}
return $self->$orig unless @_;
$self->$orig(@_);
return undef;
};
=head1 SEE ALSO
=over
=item *
L
=back
=cut
1;
SQL-Translator-0.11018/lib/SQL/Translator/Types.pm 0000644 0001750 0001750 00000004632 12234455220 020146 0 ustar frew frew package SQL::Translator::Types;
=head1 NAME
SQL::Translator::Types - Type checking functions
=head1 SYNOPSIS
package Foo;
use Moo;
use SQL::Translator::Types qw(schema_obj enum);
has foo => ( is => 'rw', isa => schema_obj('Trigger') );
has bar => ( is => 'rw', isa => enum([qw(baz quux quuz)], {
msg => "Invalid value for bar: '%s'", icase => 1,
});
=head1 DESCRIPTIONS
This module exports functions that return coderefs suitable for L
C type checks.
Errors are reported using L.
=cut
use strictures 1;
use SQL::Translator::Utils qw(throw);
use Scalar::Util qw(blessed);
use Exporter qw(import);
our @EXPORT_OK = qw(schema_obj enum);
=head1 FUNCTIONS
=head2 schema_obj($type)
Returns a coderef that checks that its arguments is an object of the
class C<< SQL::Translator::Schema::I<$type> >>.
=cut
sub schema_obj {
my ($class) = @_;
my $name = lc $class;
$class = 'SQL::Translator::Schema' . ($class eq 'Schema' ? '' : "::$class");
return sub {
throw("Not a $name object")
unless blessed($_[0]) and $_[0]->isa($class);
};
}
=head2 enum(\@strings, [$msg | \%parameters])
Returns a coderef that checks that the argument is one of the provided
C<@strings>.
=head3 Parameters
=over
=item msg
L string for the error message.
If no other parameters are needed, this can be provided on its own,
instead of the C<%parameters> hashref.
The invalid value is passed as the only argument.
Defaults to C.
=item icase
If true, folds the values to lower case before checking for equality.
=item allow_undef
If true, allow C in addition to the specified strings.
=item allow_false
If true, allow any false value in addition to the specified strings.
=back
=cut
sub enum {
my ($values, $args) = @_;
$args ||= {};
$args = { msg => $args } unless ref($args) eq 'HASH';
my $icase = !!$args->{icase};
my %values = map { ($icase ? lc : $_) => undef } @{$values};
my $msg = $args->{msg} || "Invalid value: '%s'";
my $extra_test =
$args->{allow_undef} ? sub { defined $_[0] } :
$args->{allow_false} ? sub { !!$_[0] } : undef;
return sub {
my $val = $icase ? lc $_[0] : $_[0];
throw(sprintf($msg, $val))
if (!defined($extra_test) || $extra_test->($val))
&& !exists $values{$val};
};
}
1;
SQL-Translator-0.11018/lib/SQL/Translator/Schema.pm 0000644 0001750 0001750 00000041736 12234455220 020250 0 ustar frew frew package SQL::Translator::Schema;
=pod
=head1 NAME
SQL::Translator::Schema - SQL::Translator schema object
=head1 SYNOPSIS
use SQL::Translator::Schema;
my $schema = SQL::Translator::Schema->new(
name => 'Foo',
database => 'MySQL',
);
my $table = $schema->add_table( name => 'foo' );
my $view = $schema->add_view( name => 'bar', sql => '...' );
=head1 DESCSIPTION
C is the object that accepts, validates, and
returns the database structure.
=head1 METHODS
=cut
use Moo;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Schema::Procedure;
use SQL::Translator::Schema::Table;
use SQL::Translator::Schema::Trigger;
use SQL::Translator::Schema::View;
use Sub::Quote qw(quote_sub);
use SQL::Translator::Utils 'parse_list_arg';
use Carp;
extends 'SQL::Translator::Schema::Object';
our $VERSION = '1.59';
has _order => (is => 'ro', default => quote_sub(q{ +{ map { $_ => 0 } qw/
table
view
trigger
proc
/} }),
);
sub as_graph_pm {
=pod
=head2 as_graph_pm
Returns a Graph::Directed object with the table names for nodes.
=cut
require Graph::Directed;
my $self = shift;
my $g = Graph::Directed->new;
for my $table ( $self->get_tables ) {
my $tname = $table->name;
$g->add_vertex( $tname );
for my $field ( $table->get_fields ) {
if ( $field->is_foreign_key ) {
my $fktable = $field->foreign_key_reference->reference_table;
$g->add_edge( $fktable, $tname );
}
}
}
return $g;
}
has _tables => ( is => 'ro', init_arg => undef, default => quote_sub(q{ +{} }) );
sub add_table {
=pod
=head2 add_table
Add a table object. Returns the new SQL::Translator::Schema::Table object.
The "name" parameter is required. If you try to create a table with the
same name as an existing table, you will get an error and the table will
not be created.
my $t1 = $schema->add_table( name => 'foo' ) or die $schema->error;
my $t2 = SQL::Translator::Schema::Table->new( name => 'bar' );
$t2 = $schema->add_table( $table_bar ) or die $schema->error;
=cut
my $self = shift;
my $table_class = 'SQL::Translator::Schema::Table';
my $table;
if ( UNIVERSAL::isa( $_[0], $table_class ) ) {
$table = shift;
$table->schema($self);
}
else {
my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
$args{'schema'} = $self;
$table = $table_class->new( \%args )
or return $self->error( $table_class->error );
}
$table->order( ++$self->_order->{table} );
# We know we have a name as the Table->new above errors if none given.
my $table_name = $table->name;
if ( defined $self->_tables->{$table_name} ) {
return $self->error(qq[Can't use table name "$table_name": table exists]);
}
else {
$self->_tables->{$table_name} = $table;
}
return $table;
}
sub drop_table {
=pod
=head2 drop_table
Remove a table from the schema. Returns the table object if the table was found
and removed, an error otherwise. The single parameter can be either a table
name or an C object. The "cascade" parameter
can be set to 1 to also drop all triggers on the table, default is 0.
$schema->drop_table('mytable');
$schema->drop_table('mytable', cascade => 1);
=cut
my $self = shift;
my $table_class = 'SQL::Translator::Schema::Table';
my $table_name;
if ( UNIVERSAL::isa( $_[0], $table_class ) ) {
$table_name = shift->name;
}
else {
$table_name = shift;
}
my %args = @_;
my $cascade = $args{'cascade'};
if ( !exists $self->_tables->{$table_name} ) {
return $self->error(qq[Can't drop table: "$table_name" doesn't exist]);
}
my $table = delete $self->_tables->{$table_name};
if ($cascade) {
# Drop all triggers on this table
$self->drop_trigger()
for ( grep { $_->on_table eq $table_name } values %{ $self->_triggers } );
}
return $table;
}
has _procedures => ( is => 'ro', init_arg => undef, default => quote_sub(q{ +{} }) );
sub add_procedure {
=pod
=head2 add_procedure
Add a procedure object. Returns the new SQL::Translator::Schema::Procedure
object. The "name" parameter is required. If you try to create a procedure
with the same name as an existing procedure, you will get an error and the
procedure will not be created.
my $p1 = $schema->add_procedure( name => 'foo' );
my $p2 = SQL::Translator::Schema::Procedure->new( name => 'bar' );
$p2 = $schema->add_procedure( $procedure_bar ) or die $schema->error;
=cut
my $self = shift;
my $procedure_class = 'SQL::Translator::Schema::Procedure';
my $procedure;
if ( UNIVERSAL::isa( $_[0], $procedure_class ) ) {
$procedure = shift;
$procedure->schema($self);
}
else {
my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
$args{'schema'} = $self;
return $self->error('No procedure name') unless $args{'name'};
$procedure = $procedure_class->new( \%args )
or return $self->error( $procedure_class->error );
}
$procedure->order( ++$self->_order->{proc} );
my $procedure_name = $procedure->name
or return $self->error('No procedure name');
if ( defined $self->_procedures->{$procedure_name} ) {
return $self->error(
qq[Can't create procedure: "$procedure_name" exists] );
}
else {
$self->_procedures->{$procedure_name} = $procedure;
}
return $procedure;
}
sub drop_procedure {
=pod
=head2 drop_procedure
Remove a procedure from the schema. Returns the procedure object if the
procedure was found and removed, an error otherwise. The single parameter
can be either a procedure name or an C
object.
$schema->drop_procedure('myprocedure');
=cut
my $self = shift;
my $proc_class = 'SQL::Translator::Schema::Procedure';
my $proc_name;
if ( UNIVERSAL::isa( $_[0], $proc_class ) ) {
$proc_name = shift->name;
}
else {
$proc_name = shift;
}
if ( !exists $self->_procedures->{$proc_name} ) {
return $self->error(
qq[Can't drop procedure: "$proc_name" doesn't exist]);
}
my $proc = delete $self->_procedures->{$proc_name};
return $proc;
}
has _triggers => ( is => 'ro', init_arg => undef, default => quote_sub(q{ +{} }) );
sub add_trigger {
=pod
=head2 add_trigger
Add a trigger object. Returns the new SQL::Translator::Schema::Trigger object.
The "name" parameter is required. If you try to create a trigger with the
same name as an existing trigger, you will get an error and the trigger will
not be created.
my $t1 = $schema->add_trigger( name => 'foo' );
my $t2 = SQL::Translator::Schema::Trigger->new( name => 'bar' );
$t2 = $schema->add_trigger( $trigger_bar ) or die $schema->error;
=cut
my $self = shift;
my $trigger_class = 'SQL::Translator::Schema::Trigger';
my $trigger;
if ( UNIVERSAL::isa( $_[0], $trigger_class ) ) {
$trigger = shift;
$trigger->schema($self);
}
else {
my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
$args{'schema'} = $self;
return $self->error('No trigger name') unless $args{'name'};
$trigger = $trigger_class->new( \%args )
or return $self->error( $trigger_class->error );
}
$trigger->order( ++$self->_order->{trigger} );
my $trigger_name = $trigger->name or return $self->error('No trigger name');
if ( defined $self->_triggers->{$trigger_name} ) {
return $self->error(qq[Can't create trigger: "$trigger_name" exists]);
}
else {
$self->_triggers->{$trigger_name} = $trigger;
}
return $trigger;
}
sub drop_trigger {
=pod
=head2 drop_trigger
Remove a trigger from the schema. Returns the trigger object if the trigger was
found and removed, an error otherwise. The single parameter can be either a
trigger name or an C object.
$schema->drop_trigger('mytrigger');
=cut
my $self = shift;
my $trigger_class = 'SQL::Translator::Schema::Trigger';
my $trigger_name;
if ( UNIVERSAL::isa( $_[0], $trigger_class ) ) {
$trigger_name = shift->name;
}
else {
$trigger_name = shift;
}
if ( !exists $self->_triggers->{$trigger_name} ) {
return $self->error(
qq[Can't drop trigger: "$trigger_name" doesn't exist]);
}
my $trigger = delete $self->_triggers->{$trigger_name};
return $trigger;
}
has _views => ( is => 'ro', init_arg => undef, default => quote_sub(q{ +{} }) );
sub add_view {
=pod
=head2 add_view
Add a view object. Returns the new SQL::Translator::Schema::View object.
The "name" parameter is required. If you try to create a view with the
same name as an existing view, you will get an error and the view will
not be created.
my $v1 = $schema->add_view( name => 'foo' );
my $v2 = SQL::Translator::Schema::View->new( name => 'bar' );
$v2 = $schema->add_view( $view_bar ) or die $schema->error;
=cut
my $self = shift;
my $view_class = 'SQL::Translator::Schema::View';
my $view;
if ( UNIVERSAL::isa( $_[0], $view_class ) ) {
$view = shift;
$view->schema($self);
}
else {
my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
$args{'schema'} = $self;
return $self->error('No view name') unless $args{'name'};
$view = $view_class->new( \%args ) or return $view_class->error;
}
$view->order( ++$self->_order->{view} );
my $view_name = $view->name or return $self->error('No view name');
if ( defined $self->_views->{$view_name} ) {
return $self->error(qq[Can't create view: "$view_name" exists]);
}
else {
$self->_views->{$view_name} = $view;
}
return $view;
}
sub drop_view {
=pod
=head2 drop_view
Remove a view from the schema. Returns the view object if the view was found
and removed, an error otherwise. The single parameter can be either a view
name or an C object.
$schema->drop_view('myview');
=cut
my $self = shift;
my $view_class = 'SQL::Translator::Schema::View';
my $view_name;
if ( UNIVERSAL::isa( $_[0], $view_class ) ) {
$view_name = shift->name;
}
else {
$view_name = shift;
}
if ( !exists $self->_views->{$view_name} ) {
return $self->error(qq[Can't drop view: "$view_name" doesn't exist]);
}
my $view = delete $self->_views->{$view_name};
return $view;
}
=head2 database
Get or set the schema's database. (optional)
my $database = $schema->database('PostgreSQL');
=cut
has database => ( is => 'rw', default => quote_sub(q{ '' }) );
sub is_valid {
=pod
=head2 is_valid
Returns true if all the tables and views are valid.
my $ok = $schema->is_valid or die $schema->error;
=cut
my $self = shift;
return $self->error('No tables') unless $self->get_tables;
for my $object ( $self->get_tables, $self->get_views ) {
return $object->error unless $object->is_valid;
}
return 1;
}
sub get_procedure {
=pod
=head2 get_procedure
Returns a procedure by the name provided.
my $procedure = $schema->get_procedure('foo');
=cut
my $self = shift;
my $procedure_name = shift or return $self->error('No procedure name');
return $self->error(qq[Table "$procedure_name" does not exist])
unless exists $self->_procedures->{$procedure_name};
return $self->_procedures->{$procedure_name};
}
sub get_procedures {
=pod
=head2 get_procedures
Returns all the procedures as an array or array reference.
my @procedures = $schema->get_procedures;
=cut
my $self = shift;
my @procedures =
map { $_->[1] }
sort { $a->[0] <=> $b->[0] }
map { [ $_->order, $_ ] } values %{ $self->_procedures };
if (@procedures) {
return wantarray ? @procedures : \@procedures;
}
else {
$self->error('No procedures');
return;
}
}
sub get_table {
=pod
=head2 get_table
Returns a table by the name provided.
my $table = $schema->get_table('foo');
=cut
my $self = shift;
my $table_name = shift or return $self->error('No table name');
my $case_insensitive = shift;
if ( $case_insensitive ) {
$table_name = uc($table_name);
foreach my $table ( keys %{$self->_tables} ) {
return $self->_tables->{$table} if $table_name eq uc($table);
}
return $self->error(qq[Table "$table_name" does not exist]);
}
return $self->error(qq[Table "$table_name" does not exist])
unless exists $self->_tables->{$table_name};
return $self->_tables->{$table_name};
}
sub get_tables {
=pod
=head2 get_tables
Returns all the tables as an array or array reference.
my @tables = $schema->get_tables;
=cut
my $self = shift;
my @tables =
map { $_->[1] }
sort { $a->[0] <=> $b->[0] }
map { [ $_->order, $_ ] } values %{ $self->_tables };
if (@tables) {
return wantarray ? @tables : \@tables;
}
else {
$self->error('No tables');
return;
}
}
sub get_trigger {
=pod
=head2 get_trigger
Returns a trigger by the name provided.
my $trigger = $schema->get_trigger('foo');
=cut
my $self = shift;
my $trigger_name = shift or return $self->error('No trigger name');
return $self->error(qq[Trigger "$trigger_name" does not exist])
unless exists $self->_triggers->{$trigger_name};
return $self->_triggers->{$trigger_name};
}
sub get_triggers {
=pod
=head2 get_triggers
Returns all the triggers as an array or array reference.
my @triggers = $schema->get_triggers;
=cut
my $self = shift;
my @triggers =
map { $_->[1] }
sort { $a->[0] <=> $b->[0] }
map { [ $_->order, $_ ] } values %{ $self->_triggers };
if (@triggers) {
return wantarray ? @triggers : \@triggers;
}
else {
$self->error('No triggers');
return;
}
}
sub get_view {
=pod
=head2 get_view
Returns a view by the name provided.
my $view = $schema->get_view('foo');
=cut
my $self = shift;
my $view_name = shift or return $self->error('No view name');
return $self->error('View "$view_name" does not exist')
unless exists $self->_views->{$view_name};
return $self->_views->{$view_name};
}
sub get_views {
=pod
=head2 get_views
Returns all the views as an array or array reference.
my @views = $schema->get_views;
=cut
my $self = shift;
my @views =
map { $_->[1] }
sort { $a->[0] <=> $b->[0] }
map { [ $_->order, $_ ] } values %{ $self->_views };
if (@views) {
return wantarray ? @views : \@views;
}
else {
$self->error('No views');
return;
}
}
sub make_natural_joins {
=pod
=head2 make_natural_joins
Creates foreign key relationships among like-named fields in different
tables. Accepts the following arguments:
=over 4
=item * join_pk_only
A True or False argument which determines whether or not to perform
the joins from primary keys to fields of the same name in other tables
=item * skip_fields
A list of fields to skip in the joins
=back
$schema->make_natural_joins(
join_pk_only => 1,
skip_fields => 'name,department_id',
);
=cut
my $self = shift;
my %args = @_;
my $join_pk_only = $args{'join_pk_only'} || 0;
my %skip_fields =
map { s/^\s+|\s+$//g; $_, 1 } @{ parse_list_arg( $args{'skip_fields'} ) };
my ( %common_keys, %pk );
for my $table ( $self->get_tables ) {
for my $field ( $table->get_fields ) {
my $field_name = $field->name or next;
next if $skip_fields{$field_name};
$pk{$field_name} = 1 if $field->is_primary_key;
push @{ $common_keys{$field_name} }, $table->name;
}
}
for my $field ( keys %common_keys ) {
next if $join_pk_only and !defined $pk{$field};
my @table_names = @{ $common_keys{$field} };
next unless scalar @table_names > 1;
for my $i ( 0 .. $#table_names ) {
my $table1 = $self->get_table( $table_names[$i] ) or next;
for my $j ( 1 .. $#table_names ) {
my $table2 = $self->get_table( $table_names[$j] ) or next;
next if $table1->name eq $table2->name;
$table1->add_constraint(
type => FOREIGN_KEY,
fields => $field,
reference_table => $table2->name,
reference_fields => $field,
);
}
}
}
return 1;
}
=head2 name
Get or set the schema's name. (optional)
my $schema_name = $schema->name('Foo Database');
=cut
has name => ( is => 'rw', default => quote_sub(q{ '' }) );
=pod
=head2 translator
Get the SQL::Translator instance that instantiated the parser.
=cut
has translator => ( is => 'rw', weak_ref => 1 );
1;
=pod
=head1 AUTHOR
Ken Youens-Clark Ekclark@cpan.orgE.
=cut
SQL-Translator-0.11018/lib/SQL/Translator/Utils.pm 0000644 0001750 0001750 00000033405 12143357340 020145 0 ustar frew frew package SQL::Translator::Utils;
use strict;
use warnings;
use Digest::SHA qw( sha1_hex );
use File::Spec;
use Scalar::Util qw(blessed);
use Try::Tiny;
use Carp qw(carp);
our $VERSION = '1.59';
our $DEFAULT_COMMENT = '-- ';
use base qw(Exporter);
our @EXPORT_OK = qw(
debug normalize_name header_comment parse_list_arg truncate_id_uniquely
$DEFAULT_COMMENT parse_mysql_version parse_dbms_version
ddl_parser_instance
throw ex2err carp_ro
);
use constant COLLISION_TAG_LENGTH => 8;
sub debug {
my ($pkg, $file, $line, $sub) = caller(0);
{
no strict qw(refs);
return unless ${"$pkg\::DEBUG"};
}
$sub =~ s/^$pkg\:://;
while (@_) {
my $x = shift;
chomp $x;
$x =~ s/\bPKG\b/$pkg/g;
$x =~ s/\bLINE\b/$line/g;
$x =~ s/\bSUB\b/$sub/g;
#warn '[' . $x . "]\n";
print STDERR '[' . $x . "]\n";
}
}
sub normalize_name {
my $name = shift or return '';
# The name can only begin with a-zA-Z_; if there's anything
# else, prefix with _
$name =~ s/^([^a-zA-Z_])/_$1/;
# anything other than a-zA-Z0-9_ in the non-first position
# needs to be turned into _
$name =~ tr/[a-zA-Z0-9_]/_/c;
# All duplicated _ need to be squashed into one.
$name =~ tr/_/_/s;
# Trim a trailing _
$name =~ s/_$//;
return $name;
}
sub header_comment {
my $producer = shift || caller;
my $comment_char = shift;
my $now = scalar localtime;
$comment_char = $DEFAULT_COMMENT
unless defined $comment_char;
my $header_comment =<<"HEADER_COMMENT";
${comment_char}
${comment_char}Created by $producer
${comment_char}Created on $now
${comment_char}
HEADER_COMMENT
# Any additional stuff passed in
for my $additional_comment (@_) {
$header_comment .= "${comment_char}${additional_comment}\n";
}
return $header_comment;
}
sub parse_list_arg {
my $list = UNIVERSAL::isa( $_[0], 'ARRAY' ) ? shift : [ @_ ];
#
# This protects stringification of references.
#
if ( @$list && ref $list->[0] ) {
return $list;
}
#
# This processes string-like arguments.
#
else {
return [
map { s/^\s+|\s+$//g; $_ }
map { split /,/ }
grep { defined && length } @$list
];
}
}
sub truncate_id_uniquely {
my ( $desired_name, $max_symbol_length ) = @_;
return $desired_name
unless defined $desired_name && length $desired_name > $max_symbol_length;
my $truncated_name = substr $desired_name, 0,
$max_symbol_length - COLLISION_TAG_LENGTH - 1;
# Hex isn't the most space-efficient, but it skirts around allowed
# charset issues
my $digest = sha1_hex($desired_name);
my $collision_tag = substr $digest, 0, COLLISION_TAG_LENGTH;
return $truncated_name
. '_'
. $collision_tag;
}
sub parse_mysql_version {
my ($v, $target) = @_;
return undef unless $v;
$target ||= 'perl';
my @vers;
# X.Y.Z style
if ( $v =~ / ^ (\d+) \. (\d{1,3}) (?: \. (\d{1,3}) )? $ /x ) {
push @vers, $1, $2, $3;
}
# XYYZZ (mysql) style
elsif ( $v =~ / ^ (\d) (\d{2}) (\d{2}) $ /x ) {
push @vers, $1, $2, $3;
}
# XX.YYYZZZ (perl) style or simply X
elsif ( $v =~ / ^ (\d+) (?: \. (\d{3}) (\d{3}) )? $ /x ) {
push @vers, $1, $2, $3;
}
else {
#how do I croak sanely here?
die "Unparseable MySQL version '$v'";
}
if ($target eq 'perl') {
return sprintf ('%d.%03d%03d', map { $_ || 0 } (@vers) );
}
elsif ($target eq 'mysql') {
return sprintf ('%d%02d%02d', map { $_ || 0 } (@vers) );
}
else {
#how do I croak sanely here?
die "Unknown version target '$target'";
}
}
sub parse_dbms_version {
my ($v, $target) = @_;
return undef unless $v;
my @vers;
# X.Y.Z style
if ( $v =~ / ^ (\d+) \. (\d{1,3}) (?: \. (\d{1,3}) )? $ /x ) {
push @vers, $1, $2, $3;
}
# XX.YYYZZZ (perl) style or simply X
elsif ( $v =~ / ^ (\d+) (?: \. (\d{3}) (\d{3}) )? $ /x ) {
push @vers, $1, $2, $3;
}
else {
#how do I croak sanely here?
die "Unparseable database server version '$v'";
}
if ($target eq 'perl') {
return sprintf ('%d.%03d%03d', map { $_ || 0 } (@vers) );
}
elsif ($target eq 'native') {
return join '.' => grep defined, @vers;
}
else {
#how do I croak sanely here?
die "Unknown version target '$target'";
}
}
#my ($parsers_libdir, $checkout_dir);
sub ddl_parser_instance {
my $type = shift;
# it may differ from our caller, even though currently this is not the case
eval "require SQL::Translator::Parser::$type"
or die "Unable to load grammar-spec container SQL::Translator::Parser::$type:\n$@";
# handle DB2 in a special way, since the grammar source was lost :(
if ($type eq 'DB2') {
require SQL::Translator::Parser::DB2::Grammar;
return SQL::Translator::Parser::DB2::Grammar->new;
}
require Parse::RecDescent;
return Parse::RecDescent->new(do {
no strict 'refs';
${"SQL::Translator::Parser::${type}::GRAMMAR"}
|| die "No \$SQL::Translator::Parser::${type}::GRAMMAR defined, unable to instantiate PRD parser\n"
});
# this is disabled until RT#74593 is resolved
=begin for general sadness
unless ($parsers_libdir) {
# are we in a checkout?
if ($checkout_dir = _find_co_root()) {
$parsers_libdir = File::Spec->catdir($checkout_dir, 'share', 'PrecompiledParsers');
}
else {
require File::ShareDir;
$parsers_libdir = File::Spec->catdir(
File::ShareDir::dist_dir('SQL-Translator'),
'PrecompiledParsers'
);
}
unshift @INC, $parsers_libdir;
}
my $precompiled_mod = "Parse::RecDescent::DDL::SQLT::$type";
# FIXME FIXME FIXME
# Parse::RecDescent has horrible architecture where each precompiled parser
# instance shares global state with all its siblings
# What we do here is gross, but scarily efficient - the parser compilation
# is much much slower than an unload/reload cycle
require Class::Unload;
Class::Unload->unload($precompiled_mod);
# There is also a sub-namespace that P::RD uses, but simply unsetting
# $^W to stop redefine warnings seems to be enough
#Class::Unload->unload("Parse::RecDescent::$precompiled_mod");
eval "local \$^W; require $precompiled_mod" or do {
if ($checkout_dir) {
die "Unable to find precompiled grammar for $type - run Makefile.PL to generate it\n";
}
else {
die "Unable to load precompiled grammar for $type... this is not supposed to happen if you are not in a checkout, please file a bugreport:\n$@"
}
};
my $grammar_spec_fn = $INC{"SQL/Translator/Parser/$type.pm"};
my $precompiled_fn = $INC{"Parse/RecDescent/DDL/SQLT/$type.pm"};
if (
(stat($grammar_spec_fn))[9]
>
(stat($precompiled_fn))[9]
) {
die (
"Grammar spec '$grammar_spec_fn' is newer than precompiled parser '$precompiled_fn'"
. ($checkout_dir
? " - run Makefile.PL to regenerate stale versions\n"
: "... this is not supposed to happen if you are not in a checkout, please file a bugreport\n"
)
);
}
return $precompiled_mod->new;
=cut
}
# Try to determine the root of a checkout/untar if possible
# or return undef
sub _find_co_root {
my @mod_parts = split /::/, (__PACKAGE__ . '.pm');
my $rel_path = join ('/', @mod_parts); # %INC stores paths with / regardless of OS
return undef unless ($INC{$rel_path});
# a bit convoluted, but what we do here essentially is:
# - get the file name of this particular module
# - do 'cd ..' as many times as necessary to get to lib/SQL/Translator/../../..
my $root = (File::Spec::Unix->splitpath($INC{$rel_path}))[1];
for (1 .. @mod_parts) {
$root = File::Spec->catdir($root, File::Spec->updir);
}
return ( -f File::Spec->catfile($root, 'Makefile.PL') )
? $root
: undef
;
}
{
package SQL::Translator::Utils::Error;
use overload
'""' => sub { ${$_[0]} },
fallback => 1;
sub new {
my ($class, $msg) = @_;
bless \$msg, $class;
}
}
sub throw {
die SQL::Translator::Utils::Error->new($_[0]);
}
sub ex2err {
my ($orig, $self, @args) = @_;
return try {
$self->$orig(@args);
} catch {
die $_ unless blessed($_) && $_->isa("SQL::Translator::Utils::Error");
$self->error("$_");
};
}
sub carp_ro {
my ($name) = @_;
return sub {
my ($orig, $self) = (shift, shift);
carp "'$name' is a read-only accessor" if @_;
return $self->$orig;
};
}
1;
=pod
=head1 NAME
SQL::Translator::Utils - SQL::Translator Utility functions
=head1 SYNOPSIS
use SQL::Translator::Utils qw(debug);
debug("PKG: Bad things happened");
=head1 DESCSIPTION
C contains utility functions designed to be
used from the other modules within the C modules.
Nothing is exported by default.
=head1 EXPORTED FUNCTIONS AND CONSTANTS
=head2 debug
C takes 0 or more messages, which will be sent to STDERR using
C. Occurances of the strings I, I, and I
will be replaced by the calling package, subroutine, and line number,
respectively, as reported by C.
For example, from within C in F, at line 666:
debug("PKG: Error reading file at SUB/LINE");
Will warn
[SQL::Translator: Error reading file at foo/666]
The entire message is enclosed within C<[> and C<]> for visual clarity
when STDERR is intermixed with STDOUT.
=head2 normalize_name
C takes a string and ensures that it is suitable for
use as an identifier. This means: ensure that it starts with a letter
or underscore, and that the rest of the string consists of only
letters, numbers, and underscores. A string that begins with
something other than [a-zA-Z] will be prefixer with an underscore, and
all other characters in the string will be replaced with underscores.
Finally, a trailing underscore will be removed, because that's ugly.
normalize_name("Hello, world");
Produces:
Hello_world
A more useful example, from the C test
suite:
normalize_name("silly field (with random characters)");
returns:
silly_field_with_random_characters
=head2 header_comment
Create the header comment. Takes 1 mandatory argument (the producer
classname), an optional comment character (defaults to $DEFAULT_COMMENT),
and 0 or more additional comments, which will be appended to the header,
prefixed with the comment character. If additional comments are provided,
then a comment string must be provided ($DEFAULT_COMMENT is exported for
this use). For example, this:
package My::Producer;
use SQL::Translator::Utils qw(header_comment $DEFAULT_COMMENT);
print header_comment(__PACKAGE__,
$DEFAULT_COMMENT,
"Hi mom!");
produces:
--
-- Created by My::Prodcuer
-- Created on Fri Apr 25 06:56:02 2003
--
-- Hi mom!
--
Note the gratuitous spacing.
=head2 parse_list_arg
Takes a string, list or arrayref (all of which could contain
comma-separated values) and returns an array reference of the values.
All of the following will return equivalent values:
parse_list_arg('id');
parse_list_arg('id', 'name');
parse_list_arg( 'id, name' );
parse_list_arg( [ 'id', 'name' ] );
parse_list_arg( qw[ id name ] );
=head2 truncate_id_uniquely
Takes a string ($desired_name) and int ($max_symbol_length). Truncates
$desired_name to $max_symbol_length by including part of the hash of
the full name at the end of the truncated name, giving a high
probability that the symbol will be unique. For example,
truncate_id_uniquely( 'a' x 100, 64 )
truncate_id_uniquely( 'a' x 99 . 'b', 64 );
truncate_id_uniquely( 'a' x 99, 64 )
Will give three different results; specifically:
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa_7f900025
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa_6191e39a
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa_8cd96af2
=head2 $DEFAULT_COMMENT
This is the default comment string, '-- ' by default. Useful for
C.
=head2 parse_mysql_version
Used by both L and
L in order to provide a
consistent format for both C<< parser_args->{mysql_parser_version} >> and
C<< producer_args->{mysql_version} >> respectively. Takes any of the following
version specifications:
5.0.3
4.1
3.23.2
5
5.001005 (perl style)
30201 (mysql style)
=head2 parse_dbms_version
Takes a version string (X.Y.Z) or perl style (XX.YYYZZZ) and a target ('perl'
or 'native') transforms the string to the given target style.
to
=head2 throw
Throws the provided string as an object that will stringify back to the
original string. This stops it from being mangled by L's C
code.
=head2 ex2err
Wraps an attribute accessor to catch any exception raised using
L and store them in C<< $self->error() >>, finally returning
undef. A reference to this function can be passed directly to
L.
around foo => \&ex2err;
around bar => sub {
my ($orig, $self) = (shift, shift);
return ex2err($orig, $self, @_) if @_;
...
};
=head2 carp_ro
Takes a field name and returns a reference to a function can be used
L a read-only accessor to make it L
instead of die when passed an argument.
=head1 AUTHORS
Darren Chamberlain Edarren@cpan.orgE,
Ken Y. Clark Ekclark@cpan.orgE.
=cut
SQL-Translator-0.11018/lib/SQL/Translator/Parser/ 0000755 0001750 0001750 00000000000 12234461403 017733 5 ustar frew frew SQL-Translator-0.11018/lib/SQL/Translator/Parser/DB2/ 0000755 0001750 0001750 00000000000 12234461403 020302 5 ustar frew frew SQL-Translator-0.11018/lib/SQL/Translator/Parser/DB2/Grammar.pm 0000644 0001750 0001750 00011364244 12143357340 022250 0 ustar frew frew package SQL::Translator::Parser::DB2::Grammar;
use Parse::RecDescent;
{ my $ERRORS;
package Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar;
use strict;
use vars qw($skip $AUTOLOAD );
$skip = '\s*';
my ( %tables, $table_order, @table_comments, @views, @triggers );
;
{
local $SIG{__WARN__} = sub {0};
# PRETEND TO BE IN Parse::RecDescent NAMESPACE
*Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::AUTOLOAD = sub
{
no strict 'refs';
$AUTOLOAD =~ s/^Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar/Parse::RecDescent/;
goto &{$AUTOLOAD};
}
}
push @Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::ISA, 'Parse::RecDescent';
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_17_of_rule_sysibm_function
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"_alternation_1_of_production_17_of_rule_sysibm_function"};
Parse::RecDescent::_trace(q{Trying rule: [_alternation_1_of_production_17_of_rule_sysibm_function]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_17_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/DECIMAL/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_17_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_17_of_rule_sysibm_function});
%item = (__RULE__ => q{_alternation_1_of_production_17_of_rule_sysibm_function});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/DECIMAL/i]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_17_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:DECIMAL)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/DECIMAL/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_17_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/DEC/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_17_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_17_of_rule_sysibm_function});
%item = (__RULE__ => q{_alternation_1_of_production_17_of_rule_sysibm_function});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/DEC/i]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_17_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:DEC)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/DEC/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_17_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_17_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{_alternation_1_of_production_17_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{_alternation_1_of_production_17_of_rule_sysibm_function},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{_alternation_1_of_production_17_of_rule_sysibm_function},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::triggered_action
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"triggered_action"};
Parse::RecDescent::_trace(q{Trying rule: [triggered_action]},
Parse::RecDescent::_tracefirst($_[1]),
q{triggered_action},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [when_clause SQL_procedure_statement]},
Parse::RecDescent::_tracefirst($_[1]),
q{triggered_action},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{triggered_action});
%item = (__RULE__ => q{triggered_action});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying repeated subrule: [when_clause]},
Parse::RecDescent::_tracefirst($text),
q{triggered_action},
$tracelevel)
if defined $::RD_TRACE;
$expectation->is(q{})->at($text);
unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::when_clause, 0, 1, $_noactions,$expectation,undef)))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{triggered_action},
$tracelevel)
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched repeated subrule: [when_clause]<< (}
. @$_tok . q{ times)},
Parse::RecDescent::_tracefirst($text),
q{triggered_action},
$tracelevel)
if defined $::RD_TRACE;
$item{q{when_clause(?)}} = $_tok;
push @item, $_tok;
Parse::RecDescent::_trace(q{Trying subrule: [SQL_procedure_statement]},
Parse::RecDescent::_tracefirst($text),
q{triggered_action},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{SQL_procedure_statement})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::SQL_procedure_statement($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{triggered_action},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [SQL_procedure_statement]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{triggered_action},
$tracelevel)
if defined $::RD_TRACE;
$item{q{SQL_procedure_statement}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{Trying action},
Parse::RecDescent::_tracefirst($text),
q{triggered_action},
$tracelevel)
if defined $::RD_TRACE;
$_tok = ($_noactions) ? 0 : do { $return = { 'condition' => $item[1][0],
'statement' => $item{'SQL_procedure_statement'} };
};
unless (defined $_tok)
{
Parse::RecDescent::_trace(q{<> (return value: [undef])})
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched action<< (return value: [}
. $_tok . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $_tok;
$item{__ACTION1__}=$_tok;
Parse::RecDescent::_trace(q{>>Matched production: [when_clause SQL_procedure_statement]<<},
Parse::RecDescent::_tracefirst($text),
q{triggered_action},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{triggered_action},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{triggered_action},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{triggered_action},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{triggered_action},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_2_of_rule_search_condition
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"_alternation_1_of_production_2_of_rule_search_condition"};
Parse::RecDescent::_trace(q{Trying rule: [_alternation_1_of_production_2_of_rule_search_condition]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [predicate /SELECTIVITY/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_2_of_rule_search_condition});
%item = (__RULE__ => q{_alternation_1_of_production_2_of_rule_search_condition});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [predicate]},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::predicate($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [predicate]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
if defined $::RD_TRACE;
$item{q{predicate}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{Trying repeated subrule: [/SELECTIVITY/i]},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
if defined $::RD_TRACE;
$expectation->is(q{/SELECTIVITY/i})->at($text);
unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_1_of_rule__alternation_1_of_production_2_of_rule_search_condition, 0, 1, $_noactions,$expectation,undef)))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched repeated subrule: [_alternation_1_of_production_1_of_rule__alternation_1_of_production_2_of_rule_search_condition]<< (}
. @$_tok . q{ times)},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
if defined $::RD_TRACE;
$item{q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_2_of_rule_search_condition(?)}} = $_tok;
push @item, $_tok;
Parse::RecDescent::_trace(q{>>Matched production: [predicate /SELECTIVITY/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: ['(' search_condition ')']},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_2_of_rule_search_condition});
%item = (__RULE__ => q{_alternation_1_of_production_2_of_rule_search_condition});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: ['(']},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\(//)
{
$expectation->failed();
Parse::RecDescent::_trace(qq{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__STRING1__}=$&;
Parse::RecDescent::_trace(q{Trying subrule: [search_condition]},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{search_condition})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::search_condition($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [search_condition]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
if defined $::RD_TRACE;
$item{q{search_condition}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{Trying terminal: [')']},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{')'})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\)//)
{
$expectation->failed();
Parse::RecDescent::_trace(qq{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__STRING2__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: ['(' search_condition ')']<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{_alternation_1_of_production_2_of_rule_search_condition},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::name1
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"name1"};
Parse::RecDescent::_trace(q{Trying rule: [name1]},
Parse::RecDescent::_tracefirst($_[1]),
q{name1},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [NAME]},
Parse::RecDescent::_tracefirst($_[1]),
q{name1},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{name1});
%item = (__RULE__ => q{name1});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [NAME]},
Parse::RecDescent::_tracefirst($text),
q{name1},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::NAME($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{name1},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [NAME]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{name1},
$tracelevel)
if defined $::RD_TRACE;
$item{q{NAME}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{>>Matched production: [NAME]<<},
Parse::RecDescent::_tracefirst($text),
q{name1},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{name1},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{name1},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{name1},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{name1},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_2_of_production_1_of_rule_cond
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"_alternation_2_of_production_1_of_rule_cond"};
Parse::RecDescent::_trace(q{Trying rule: [_alternation_2_of_production_1_of_rule_cond]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [predicate /SELECTIVITY/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_2_of_production_1_of_rule_cond});
%item = (__RULE__ => q{_alternation_2_of_production_1_of_rule_cond});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [predicate]},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::predicate($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [predicate]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
$item{q{predicate}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{Trying repeated subrule: [/SELECTIVITY/i]},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
$expectation->is(q{/SELECTIVITY/i})->at($text);
unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_1_of_rule__alternation_2_of_production_1_of_rule_cond, 0, 1, $_noactions,$expectation,undef)))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched repeated subrule: [_alternation_1_of_production_1_of_rule__alternation_2_of_production_1_of_rule_cond]<< (}
. @$_tok . q{ times)},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
$item{q{_alternation_1_of_production_1_of_rule__alternation_2_of_production_1_of_rule_cond(?)}} = $_tok;
push @item, $_tok;
Parse::RecDescent::_trace(q{>>Matched production: [predicate /SELECTIVITY/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: ['(' search_condition ')']},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_2_of_production_1_of_rule_cond});
%item = (__RULE__ => q{_alternation_2_of_production_1_of_rule_cond});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: ['(']},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\(//)
{
$expectation->failed();
Parse::RecDescent::_trace(qq{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__STRING1__}=$&;
Parse::RecDescent::_trace(q{Trying subrule: [search_condition]},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{search_condition})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::search_condition($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [search_condition]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
$item{q{search_condition}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{Trying terminal: [')']},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{')'})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\)//)
{
$expectation->failed();
Parse::RecDescent::_trace(qq{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__STRING2__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: ['(' search_condition ')']<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{_alternation_2_of_production_1_of_rule_cond},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_1_of_rule_expression
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"_alternation_1_of_production_1_of_rule_expression"};
Parse::RecDescent::_trace(q{Trying rule: [_alternation_1_of_production_1_of_rule_expression]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: ['+', or '-' function, or '(', or constant, or column_name, or host_variable, or special_register, or labeled_duration, or case_expression, or cast_specification, or OLAP_function, or method_invocation, or subtype_treatment, or sequence_reference]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_1_of_rule_expression});
%item = (__RULE__ => q{_alternation_1_of_production_1_of_rule_expression});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying repeated subrule: ['+', or '-']},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
$expectation->is(q{})->at($text);
unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression, 0, 1, $_noactions,$expectation,undef)))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched repeated subrule: [_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression]<< (}
. @$_tok . q{ times)},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
$item{q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression(?)}} = $_tok;
push @item, $_tok;
Parse::RecDescent::_trace(q{Trying subrule: [_alternation_2_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression]},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{function, or '(', or constant, or column_name, or host_variable, or special_register, or labeled_duration, or case_expression, or cast_specification, or OLAP_function, or method_invocation, or subtype_treatment, or sequence_reference})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_2_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [_alternation_2_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
$item{q{_alternation_2_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{>>Matched production: ['+', or '-' function, or '(', or constant, or column_name, or host_variable, or special_register, or labeled_duration, or case_expression, or cast_specification, or OLAP_function, or method_invocation, or subtype_treatment, or sequence_reference]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{_alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{_alternation_1_of_production_1_of_rule_expression},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{_alternation_1_of_production_1_of_rule_expression},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::SCHEMA
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"SCHEMA"};
Parse::RecDescent::_trace(q{Trying rule: [SCHEMA]},
Parse::RecDescent::_tracefirst($_[1]),
q{SCHEMA},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/\\w+/]},
Parse::RecDescent::_tracefirst($_[1]),
q{SCHEMA},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{SCHEMA});
%item = (__RULE__ => q{SCHEMA});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/\\w+/]}, Parse::RecDescent::_tracefirst($text),
q{SCHEMA},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:\w+)//)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/\\w+/]<<},
Parse::RecDescent::_tracefirst($text),
q{SCHEMA},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/\\w\{1,128\}/]},
Parse::RecDescent::_tracefirst($_[1]),
q{SCHEMA},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{SCHEMA});
%item = (__RULE__ => q{SCHEMA});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/\\w\{1,128\}/]}, Parse::RecDescent::_tracefirst($text),
q{SCHEMA},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:\w{1,128})//)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/\\w\{1,128\}/]<<},
Parse::RecDescent::_tracefirst($text),
q{SCHEMA},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{SCHEMA},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{SCHEMA},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{SCHEMA},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{SCHEMA},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_87_of_rule_sysibm_function
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"_alternation_1_of_production_87_of_rule_sysibm_function"};
Parse::RecDescent::_trace(q{Trying rule: [_alternation_1_of_production_87_of_rule_sysibm_function]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_87_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/VARIANCE/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_87_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_87_of_rule_sysibm_function});
%item = (__RULE__ => q{_alternation_1_of_production_87_of_rule_sysibm_function});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/VARIANCE/i]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_87_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:VARIANCE)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/VARIANCE/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_87_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/VAR/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_87_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_87_of_rule_sysibm_function});
%item = (__RULE__ => q{_alternation_1_of_production_87_of_rule_sysibm_function});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/VAR/i]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_87_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:VAR)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/VAR/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_87_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_87_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{_alternation_1_of_production_87_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{_alternation_1_of_production_87_of_rule_sysibm_function},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{_alternation_1_of_production_87_of_rule_sysibm_function},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression"};
Parse::RecDescent::_trace(q{Trying rule: [_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: ['+']},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression});
%item = (__RULE__ => q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: ['+']},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\+//)
{
$expectation->failed();
Parse::RecDescent::_trace(qq{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__STRING1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: ['+']<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: ['-']},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression});
%item = (__RULE__ => q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: ['-']},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\-//)
{
$expectation->failed();
Parse::RecDescent::_trace(qq{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__STRING1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: ['-']<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_expression},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::get_bracketed
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"get_bracketed"};
Parse::RecDescent::_trace(q{Trying rule: [get_bracketed]},
Parse::RecDescent::_tracefirst($_[1]),
q{get_bracketed},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: []},
Parse::RecDescent::_tracefirst($_[1]),
q{get_bracketed},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{get_bracketed});
%item = (__RULE__ => q{get_bracketed});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying action},
Parse::RecDescent::_tracefirst($text),
q{get_bracketed},
$tracelevel)
if defined $::RD_TRACE;
$_tok = ($_noactions) ? 0 : do {
extract_bracketed($text, '(');
};
unless (defined $_tok)
{
Parse::RecDescent::_trace(q{<> (return value: [undef])})
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched action<< (return value: [}
. $_tok . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $_tok;
$item{__ACTION1__}=$_tok;
Parse::RecDescent::_trace(q{>>Matched production: []<<},
Parse::RecDescent::_tracefirst($text),
q{get_bracketed},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{get_bracketed},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{get_bracketed},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{get_bracketed},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{get_bracketed},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::labeled_duration
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"labeled_duration"};
Parse::RecDescent::_trace(q{Trying rule: [labeled_duration]},
Parse::RecDescent::_tracefirst($_[1]),
q{labeled_duration},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [ld_type ld_duration]},
Parse::RecDescent::_tracefirst($_[1]),
q{labeled_duration},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{labeled_duration});
%item = (__RULE__ => q{labeled_duration});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [ld_type]},
Parse::RecDescent::_tracefirst($text),
q{labeled_duration},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::ld_type($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{labeled_duration},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [ld_type]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{labeled_duration},
$tracelevel)
if defined $::RD_TRACE;
$item{q{ld_type}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{Trying subrule: [ld_duration]},
Parse::RecDescent::_tracefirst($text),
q{labeled_duration},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{ld_duration})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::ld_duration($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{labeled_duration},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [ld_duration]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{labeled_duration},
$tracelevel)
if defined $::RD_TRACE;
$item{q{ld_duration}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{>>Matched production: [ld_type ld_duration]<<},
Parse::RecDescent::_tracefirst($text),
q{labeled_duration},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{labeled_duration},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{labeled_duration},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{labeled_duration},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{labeled_duration},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::group_end
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"group_end"};
Parse::RecDescent::_trace(q{Trying rule: [group_end]},
Parse::RecDescent::_tracefirst($_[1]),
q{group_end},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/UNBOUNDED\\s+PRECEDING/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{group_end},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{group_end});
%item = (__RULE__ => q{group_end});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/UNBOUNDED\\s+PRECEDING/i]}, Parse::RecDescent::_tracefirst($text),
q{group_end},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:UNBOUNDED\s+PRECEDING)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/UNBOUNDED\\s+PRECEDING/i]<<},
Parse::RecDescent::_tracefirst($text),
q{group_end},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [unsigned_constant /FOLLOWING/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{group_end},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{group_end});
%item = (__RULE__ => q{group_end});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [unsigned_constant]},
Parse::RecDescent::_tracefirst($text),
q{group_end},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::unsigned_constant($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{group_end},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [unsigned_constant]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{group_end},
$tracelevel)
if defined $::RD_TRACE;
$item{q{unsigned_constant}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{Trying terminal: [/FOLLOWING/i]}, Parse::RecDescent::_tracefirst($text),
q{group_end},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{/FOLLOWING/i})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:FOLLOWING)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [unsigned_constant /FOLLOWING/i]<<},
Parse::RecDescent::_tracefirst($text),
q{group_end},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{group_end},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{group_end},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{group_end},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{group_end},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::statement
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"statement"};
Parse::RecDescent::_trace(q{Trying rule: [statement]},
Parse::RecDescent::_tracefirst($_[1]),
q{statement},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [comment]},
Parse::RecDescent::_tracefirst($_[1]),
q{statement},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{statement});
%item = (__RULE__ => q{statement});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [comment]},
Parse::RecDescent::_tracefirst($text),
q{statement},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::comment($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{statement},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [comment]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{statement},
$tracelevel)
if defined $::RD_TRACE;
$item{q{comment}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{>>Matched production: [comment]<<},
Parse::RecDescent::_tracefirst($text),
q{statement},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [create]},
Parse::RecDescent::_tracefirst($_[1]),
q{statement},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{statement});
%item = (__RULE__ => q{statement});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [create]},
Parse::RecDescent::_tracefirst($text),
q{statement},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::create($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{statement},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [create]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{statement},
$tracelevel)
if defined $::RD_TRACE;
$item{q{create}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{>>Matched production: [create]<<},
Parse::RecDescent::_tracefirst($text),
q{statement},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched)
{
Parse::RecDescent::_trace(q{Trying production: []},
Parse::RecDescent::_tracefirst($_[1]),
q{statement},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[2];
my $_savetext;
@item = (q{statement});
%item = (__RULE__ => q{statement});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying directive: []},
Parse::RecDescent::_tracefirst($text),
q{statement},
$tracelevel)
if defined $::RD_TRACE;
$_tok = do { if (1) { do {
my $rule = $item[0];
$rule =~ s/_/ /g;
#WAS: Parse::RecDescent::_error("Invalid $rule: " . $expectation->message() ,$thisline);
push @{$thisparser->{errors}}, ["Invalid $rule: " . $expectation->message() ,$thisline];
} unless $_noactions; undef } else {0} };
if (defined($_tok))
{
Parse::RecDescent::_trace(q{>>Matched directive<< (return value: [}
. $_tok . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
}
else
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
}
last unless defined $_tok;
push @item, $item{__DIRECTIVE1__}=$_tok;
Parse::RecDescent::_trace(q{>>Matched production: []<<},
Parse::RecDescent::_tracefirst($text),
q{statement},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{statement},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{statement},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{statement},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{statement},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause"};
Parse::RecDescent::_trace(q{Trying rule: [_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [result_expression]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause});
%item = (__RULE__ => q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [result_expression]},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::result_expression($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [result_expression]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause},
$tracelevel)
if defined $::RD_TRACE;
$item{q{result_expression}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{>>Matched production: [result_expression]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/NULL/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause});
%item = (__RULE__ => q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/NULL/i]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:NULL)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/NULL/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{_alternation_1_of_production_1_of_rule__alternation_1_of_production_1_of_rule_simple_when_clause},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_2_of_production_1_of_rule_case_expression
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"_alternation_2_of_production_1_of_rule_case_expression"};
Parse::RecDescent::_trace(q{Trying rule: [_alternation_2_of_production_1_of_rule_case_expression]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_2_of_production_1_of_rule_case_expression},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/ELSE\\s+NULL/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_2_of_production_1_of_rule_case_expression},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_2_of_production_1_of_rule_case_expression});
%item = (__RULE__ => q{_alternation_2_of_production_1_of_rule_case_expression});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/ELSE\\s+NULL/i]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_case_expression},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:ELSE\s+NULL)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/ELSE\\s+NULL/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_case_expression},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/ELSE/i result_expression]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_2_of_production_1_of_rule_case_expression},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_2_of_production_1_of_rule_case_expression});
%item = (__RULE__ => q{_alternation_2_of_production_1_of_rule_case_expression});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/ELSE/i]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_case_expression},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:ELSE)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{Trying subrule: [result_expression]},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_case_expression},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{result_expression})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::result_expression($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_case_expression},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [result_expression]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_case_expression},
$tracelevel)
if defined $::RD_TRACE;
$item{q{result_expression}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{>>Matched production: [/ELSE/i result_expression]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_case_expression},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_2_of_production_1_of_rule_case_expression},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{_alternation_2_of_production_1_of_rule_case_expression},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{_alternation_2_of_production_1_of_rule_case_expression},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{_alternation_2_of_production_1_of_rule_case_expression},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::subject_expression
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"subject_expression"};
Parse::RecDescent::_trace(q{Trying rule: [subject_expression]},
Parse::RecDescent::_tracefirst($_[1]),
q{subject_expression},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [expression]},
Parse::RecDescent::_tracefirst($_[1]),
q{subject_expression},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{subject_expression});
%item = (__RULE__ => q{subject_expression});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [expression]},
Parse::RecDescent::_tracefirst($text),
q{subject_expression},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::expression($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{subject_expression},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [expression]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{subject_expression},
$tracelevel)
if defined $::RD_TRACE;
$item{q{expression}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{Trying action},
Parse::RecDescent::_tracefirst($text),
q{subject_expression},
$tracelevel)
if defined $::RD_TRACE;
$_tok = ($_noactions) ? 0 : do { # with static result type that is a used-defined struct type
};
unless (defined $_tok)
{
Parse::RecDescent::_trace(q{<> (return value: [undef])})
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched action<< (return value: [}
. $_tok . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $_tok;
$item{__ACTION1__}=$_tok;
Parse::RecDescent::_trace(q{>>Matched production: [expression]<<},
Parse::RecDescent::_tracefirst($text),
q{subject_expression},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{subject_expression},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{subject_expression},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{subject_expression},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{subject_expression},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_1_of_rule_desc_option
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"_alternation_1_of_production_1_of_rule_desc_option"};
Parse::RecDescent::_trace(q{Trying rule: [_alternation_1_of_production_1_of_rule_desc_option]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule_desc_option},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/NULLS\\s+FIRST/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule_desc_option},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_1_of_rule_desc_option});
%item = (__RULE__ => q{_alternation_1_of_production_1_of_rule_desc_option});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/NULLS\\s+FIRST/i]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_desc_option},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:NULLS\s+FIRST)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/NULLS\\s+FIRST/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_desc_option},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/NULLS\\s+LAST/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule_desc_option},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_1_of_rule_desc_option});
%item = (__RULE__ => q{_alternation_1_of_production_1_of_rule_desc_option});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/NULLS\\s+LAST/i]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_desc_option},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:NULLS\s+LAST)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/NULLS\\s+LAST/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_desc_option},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule_desc_option},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{_alternation_1_of_production_1_of_rule_desc_option},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{_alternation_1_of_production_1_of_rule_desc_option},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{_alternation_1_of_production_1_of_rule_desc_option},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::view_name
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"view_name"};
Parse::RecDescent::_trace(q{Trying rule: [view_name]},
Parse::RecDescent::_tracefirst($_[1]),
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [SCHEMA '.' NAME]},
Parse::RecDescent::_tracefirst($_[1]),
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{view_name});
%item = (__RULE__ => q{view_name});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [SCHEMA]},
Parse::RecDescent::_tracefirst($text),
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::SCHEMA($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [SCHEMA]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
$item{q{SCHEMA}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{Trying terminal: ['.']},
Parse::RecDescent::_tracefirst($text),
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{'.'})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\.//)
{
$expectation->failed();
Parse::RecDescent::_trace(qq{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__STRING1__}=$&;
Parse::RecDescent::_trace(q{Trying subrule: [NAME]},
Parse::RecDescent::_tracefirst($text),
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{NAME})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::NAME($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [NAME]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
$item{q{NAME}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{Trying action},
Parse::RecDescent::_tracefirst($text),
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
$_tok = ($_noactions) ? 0 : do { $return = { schema => $item[1], name => $item[3] } };
unless (defined $_tok)
{
Parse::RecDescent::_trace(q{<> (return value: [undef])})
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched action<< (return value: [}
. $_tok . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $_tok;
$item{__ACTION1__}=$_tok;
Parse::RecDescent::_trace(q{>>Matched production: [SCHEMA '.' NAME]<<},
Parse::RecDescent::_tracefirst($text),
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [NAME]},
Parse::RecDescent::_tracefirst($_[1]),
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{view_name});
%item = (__RULE__ => q{view_name});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [NAME]},
Parse::RecDescent::_tracefirst($text),
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::NAME($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [NAME]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
$item{q{NAME}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{Trying action},
Parse::RecDescent::_tracefirst($text),
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
$_tok = ($_noactions) ? 0 : do { $return = { name => $item[1] } };
unless (defined $_tok)
{
Parse::RecDescent::_trace(q{<> (return value: [undef])})
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched action<< (return value: [}
. $_tok . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $_tok;
$item{__ACTION1__}=$_tok;
Parse::RecDescent::_trace(q{>>Matched production: [NAME]<<},
Parse::RecDescent::_tracefirst($text),
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{view_name},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{view_name},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{view_name},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_1_of_rule_cond
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"_alternation_1_of_production_1_of_rule_cond"};
Parse::RecDescent::_trace(q{Trying rule: [_alternation_1_of_production_1_of_rule_cond]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/AND/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_1_of_rule_cond});
%item = (__RULE__ => q{_alternation_1_of_production_1_of_rule_cond});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/AND/i]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:AND)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/AND/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/OR/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_1_of_rule_cond});
%item = (__RULE__ => q{_alternation_1_of_production_1_of_rule_cond});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/OR/i]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:OR)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/OR/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{_alternation_1_of_production_1_of_rule_cond},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{_alternation_1_of_production_1_of_rule_cond},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{_alternation_1_of_production_1_of_rule_cond},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::numbering_function
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"numbering_function"};
Parse::RecDescent::_trace(q{Trying rule: [numbering_function]},
Parse::RecDescent::_tracefirst($_[1]),
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/ROW_NUMBER|ROWNUMBER/i '()' /OVER/i '(' window_partition_clause window_order_clause /RANGE\\s+BETWEEN\\s+UNBOUNDED\\s+PRECEDING\\s+AND\\s+UNBBOUNDED\\s+FOLLOWING/i, or window_aggregation_group_clause ')']},
Parse::RecDescent::_tracefirst($_[1]),
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{numbering_function});
%item = (__RULE__ => q{numbering_function});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/ROW_NUMBER|ROWNUMBER/i]}, Parse::RecDescent::_tracefirst($text),
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:ROW_NUMBER|ROWNUMBER)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{Trying terminal: ['()']},
Parse::RecDescent::_tracefirst($text),
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{'()'})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\(\)//)
{
$expectation->failed();
Parse::RecDescent::_trace(qq{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__STRING1__}=$&;
Parse::RecDescent::_trace(q{Trying terminal: [/OVER/i]}, Parse::RecDescent::_tracefirst($text),
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{/OVER/i})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:OVER)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN2__}=$&;
Parse::RecDescent::_trace(q{Trying terminal: ['(']},
Parse::RecDescent::_tracefirst($text),
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{'('})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\(//)
{
$expectation->failed();
Parse::RecDescent::_trace(qq{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__STRING2__}=$&;
Parse::RecDescent::_trace(q{Trying repeated subrule: [window_partition_clause]},
Parse::RecDescent::_tracefirst($text),
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
$expectation->is(q{window_partition_clause})->at($text);
unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::window_partition_clause, 0, 1, $_noactions,$expectation,undef)))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched repeated subrule: [window_partition_clause]<< (}
. @$_tok . q{ times)},
Parse::RecDescent::_tracefirst($text),
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
$item{q{window_partition_clause(?)}} = $_tok;
push @item, $_tok;
Parse::RecDescent::_trace(q{Trying repeated subrule: [window_order_clause]},
Parse::RecDescent::_tracefirst($text),
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
$expectation->is(q{window_order_clause})->at($text);
unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_1_of_rule_numbering_function, 0, 1, $_noactions,$expectation,undef)))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched repeated subrule: [_alternation_1_of_production_1_of_rule_numbering_function]<< (}
. @$_tok . q{ times)},
Parse::RecDescent::_tracefirst($text),
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
$item{q{_alternation_1_of_production_1_of_rule_numbering_function(?)}} = $_tok;
push @item, $_tok;
Parse::RecDescent::_trace(q{Trying repeated subrule: [/RANGE\\s+BETWEEN\\s+UNBOUNDED\\s+PRECEDING\\s+AND\\s+UNBBOUNDED\\s+FOLLOWING/i, or window_aggregation_group_clause]},
Parse::RecDescent::_tracefirst($text),
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
$expectation->is(q{/RANGE\\s+BETWEEN\\s+UNBOUNDED\\s+PRECEDING\\s+AND\\s+UNBBOUNDED\\s+FOLLOWING/i, or window_aggregation_group_clause})->at($text);
unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_2_of_production_1_of_rule_numbering_function, 0, 1, $_noactions,$expectation,undef)))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched repeated subrule: [_alternation_2_of_production_1_of_rule_numbering_function]<< (}
. @$_tok . q{ times)},
Parse::RecDescent::_tracefirst($text),
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
$item{q{_alternation_2_of_production_1_of_rule_numbering_function(?)}} = $_tok;
push @item, $_tok;
Parse::RecDescent::_trace(q{Trying terminal: [')']},
Parse::RecDescent::_tracefirst($text),
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{')'})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\)//)
{
$expectation->failed();
Parse::RecDescent::_trace(qq{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__STRING3__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/ROW_NUMBER|ROWNUMBER/i '()' /OVER/i '(' window_partition_clause window_order_clause /RANGE\\s+BETWEEN\\s+UNBOUNDED\\s+PRECEDING\\s+AND\\s+UNBBOUNDED\\s+FOLLOWING/i, or window_aggregation_group_clause ')']<<},
Parse::RecDescent::_tracefirst($text),
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{numbering_function},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{numbering_function},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{numbering_function},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_1_of_rule_window_aggregation_group_clause
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"_alternation_1_of_production_1_of_rule_window_aggregation_group_clause"};
Parse::RecDescent::_trace(q{Trying rule: [_alternation_1_of_production_1_of_rule_window_aggregation_group_clause]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule_window_aggregation_group_clause},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/ROWS/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule_window_aggregation_group_clause},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_1_of_rule_window_aggregation_group_clause});
%item = (__RULE__ => q{_alternation_1_of_production_1_of_rule_window_aggregation_group_clause});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/ROWS/i]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_window_aggregation_group_clause},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:ROWS)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/ROWS/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_window_aggregation_group_clause},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/RANGE/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule_window_aggregation_group_clause},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_1_of_rule_window_aggregation_group_clause});
%item = (__RULE__ => q{_alternation_1_of_production_1_of_rule_window_aggregation_group_clause});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/RANGE/i]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_window_aggregation_group_clause},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:RANGE)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/RANGE/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_1_of_rule_window_aggregation_group_clause},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_1_of_rule_window_aggregation_group_clause},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{_alternation_1_of_production_1_of_rule_window_aggregation_group_clause},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{_alternation_1_of_production_1_of_rule_window_aggregation_group_clause},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{_alternation_1_of_production_1_of_rule_window_aggregation_group_clause},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::group_bound1
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"group_bound1"};
Parse::RecDescent::_trace(q{Trying rule: [group_bound1]},
Parse::RecDescent::_tracefirst($_[1]),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/UNBOUNDED\\s+PRECEDING/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{group_bound1});
%item = (__RULE__ => q{group_bound1});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/UNBOUNDED\\s+PRECEDING/i]}, Parse::RecDescent::_tracefirst($text),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:UNBOUNDED\s+PRECEDING)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/UNBOUNDED\\s+PRECEDING/i]<<},
Parse::RecDescent::_tracefirst($text),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [unsigned_constant /PRECEDING/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{group_bound1});
%item = (__RULE__ => q{group_bound1});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [unsigned_constant]},
Parse::RecDescent::_tracefirst($text),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::unsigned_constant($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [unsigned_constant]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
$item{q{unsigned_constant}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{Trying terminal: [/PRECEDING/i]}, Parse::RecDescent::_tracefirst($text),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{/PRECEDING/i})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:PRECEDING)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [unsigned_constant /PRECEDING/i]<<},
Parse::RecDescent::_tracefirst($text),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [unsigned_constant /FOLLOWING/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[2];
$text = $_[1];
my $_savetext;
@item = (q{group_bound1});
%item = (__RULE__ => q{group_bound1});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [unsigned_constant]},
Parse::RecDescent::_tracefirst($text),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::unsigned_constant($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [unsigned_constant]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
$item{q{unsigned_constant}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{Trying terminal: [/FOLLOWING/i]}, Parse::RecDescent::_tracefirst($text),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{/FOLLOWING/i})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:FOLLOWING)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [unsigned_constant /FOLLOWING/i]<<},
Parse::RecDescent::_tracefirst($text),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/CURRENT\\s+ROW/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[3];
$text = $_[1];
my $_savetext;
@item = (q{group_bound1});
%item = (__RULE__ => q{group_bound1});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/CURRENT\\s+ROW/i]}, Parse::RecDescent::_tracefirst($text),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:CURRENT\s+ROW)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/CURRENT\\s+ROW/i]<<},
Parse::RecDescent::_tracefirst($text),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{group_bound1},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{group_bound1},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{group_bound1},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::OLAP_function
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"OLAP_function"};
Parse::RecDescent::_trace(q{Trying rule: [OLAP_function]},
Parse::RecDescent::_tracefirst($_[1]),
q{OLAP_function},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [ranking_function]},
Parse::RecDescent::_tracefirst($_[1]),
q{OLAP_function},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{OLAP_function});
%item = (__RULE__ => q{OLAP_function});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [ranking_function]},
Parse::RecDescent::_tracefirst($text),
q{OLAP_function},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::ranking_function($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{OLAP_function},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [ranking_function]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{OLAP_function},
$tracelevel)
if defined $::RD_TRACE;
$item{q{ranking_function}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{>>Matched production: [ranking_function]<<},
Parse::RecDescent::_tracefirst($text),
q{OLAP_function},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [numbering_function]},
Parse::RecDescent::_tracefirst($_[1]),
q{OLAP_function},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{OLAP_function});
%item = (__RULE__ => q{OLAP_function});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [numbering_function]},
Parse::RecDescent::_tracefirst($text),
q{OLAP_function},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::numbering_function($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{OLAP_function},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [numbering_function]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{OLAP_function},
$tracelevel)
if defined $::RD_TRACE;
$item{q{numbering_function}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{>>Matched production: [numbering_function]<<},
Parse::RecDescent::_tracefirst($text),
q{OLAP_function},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [aggregation_function]},
Parse::RecDescent::_tracefirst($_[1]),
q{OLAP_function},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[2];
$text = $_[1];
my $_savetext;
@item = (q{OLAP_function});
%item = (__RULE__ => q{OLAP_function});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [aggregation_function]},
Parse::RecDescent::_tracefirst($text),
q{OLAP_function},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::aggregation_function($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{OLAP_function},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [aggregation_function]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{OLAP_function},
$tracelevel)
if defined $::RD_TRACE;
$item{q{aggregation_function}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{>>Matched production: [aggregation_function]<<},
Parse::RecDescent::_tracefirst($text),
q{OLAP_function},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{OLAP_function},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{OLAP_function},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{OLAP_function},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{OLAP_function},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_30_of_rule_sysibm_function
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"_alternation_1_of_production_30_of_rule_sysibm_function"};
Parse::RecDescent::_trace(q{Trying rule: [_alternation_1_of_production_30_of_rule_sysibm_function]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_30_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/DOUBLE/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_30_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_30_of_rule_sysibm_function});
%item = (__RULE__ => q{_alternation_1_of_production_30_of_rule_sysibm_function});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/DOUBLE/i]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_30_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:DOUBLE)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/DOUBLE/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_30_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/DOUBLE_PRECISION/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_30_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_30_of_rule_sysibm_function});
%item = (__RULE__ => q{_alternation_1_of_production_30_of_rule_sysibm_function});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/DOUBLE_PRECISION/i]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_30_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:DOUBLE_PRECISION)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/DOUBLE_PRECISION/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_30_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_30_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{_alternation_1_of_production_30_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{_alternation_1_of_production_30_of_rule_sysibm_function},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{_alternation_1_of_production_30_of_rule_sysibm_function},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::FULL
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"FULL"};
Parse::RecDescent::_trace(q{Trying rule: [FULL]},
Parse::RecDescent::_tracefirst($_[1]),
q{FULL},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/full/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{FULL},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{FULL});
%item = (__RULE__ => q{FULL});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/full/i]}, Parse::RecDescent::_tracefirst($text),
q{FULL},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:full)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/full/i]<<},
Parse::RecDescent::_tracefirst($text),
q{FULL},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{FULL},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{FULL},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{FULL},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{FULL},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_2_of_production_1_of_rule_cast_specification
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"_alternation_2_of_production_1_of_rule_cast_specification"};
Parse::RecDescent::_trace(q{Trying rule: [_alternation_2_of_production_1_of_rule_cast_specification]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_2_of_production_1_of_rule_cast_specification},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/SCOPE/ typed_table_name, or typed_view_name]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_2_of_production_1_of_rule_cast_specification},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_2_of_production_1_of_rule_cast_specification});
%item = (__RULE__ => q{_alternation_2_of_production_1_of_rule_cast_specification});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/SCOPE/]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_cast_specification},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:SCOPE)//)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{Trying subrule: [_alternation_1_of_production_1_of_rule__alternation_2_of_production_1_of_rule_cast_specification]},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_cast_specification},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{typed_table_name, or typed_view_name})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_1_of_rule__alternation_2_of_production_1_of_rule_cast_specification($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_cast_specification},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [_alternation_1_of_production_1_of_rule__alternation_2_of_production_1_of_rule_cast_specification]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_cast_specification},
$tracelevel)
if defined $::RD_TRACE;
$item{q{_alternation_1_of_production_1_of_rule__alternation_2_of_production_1_of_rule_cast_specification}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{>>Matched production: [/SCOPE/ typed_table_name, or typed_view_name]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_2_of_production_1_of_rule_cast_specification},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_2_of_production_1_of_rule_cast_specification},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{_alternation_2_of_production_1_of_rule_cast_specification},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{_alternation_2_of_production_1_of_rule_cast_specification},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{_alternation_2_of_production_1_of_rule_cast_specification},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::case_expression
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"case_expression"};
Parse::RecDescent::_trace(q{Trying rule: [case_expression]},
Parse::RecDescent::_tracefirst($_[1]),
q{case_expression},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/CASE/i searched_when_clause, or simple_when_clause /ELSE\\s+NULL/i, or /ELSE/i /END/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{case_expression},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{case_expression});
%item = (__RULE__ => q{case_expression});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/CASE/i]}, Parse::RecDescent::_tracefirst($text),
q{case_expression},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:CASE)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{Trying subrule: [_alternation_1_of_production_1_of_rule_case_expression]},
Parse::RecDescent::_tracefirst($text),
q{case_expression},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{searched_when_clause, or simple_when_clause})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_1_of_rule_case_expression($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{case_expression},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [_alternation_1_of_production_1_of_rule_case_expression]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{case_expression},
$tracelevel)
if defined $::RD_TRACE;
$item{q{_alternation_1_of_production_1_of_rule_case_expression}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{Trying repeated subrule: [/ELSE\\s+NULL/i, or /ELSE/i]},
Parse::RecDescent::_tracefirst($text),
q{case_expression},
$tracelevel)
if defined $::RD_TRACE;
$expectation->is(q{/ELSE\\s+NULL/i, or /ELSE/i})->at($text);
unless (defined ($_tok = $thisparser->_parserepeat($text, \&Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_2_of_production_1_of_rule_case_expression, 0, 1, $_noactions,$expectation,undef)))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{case_expression},
$tracelevel)
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched repeated subrule: [_alternation_2_of_production_1_of_rule_case_expression]<< (}
. @$_tok . q{ times)},
Parse::RecDescent::_tracefirst($text),
q{case_expression},
$tracelevel)
if defined $::RD_TRACE;
$item{q{_alternation_2_of_production_1_of_rule_case_expression(?)}} = $_tok;
push @item, $_tok;
Parse::RecDescent::_trace(q{Trying terminal: [/END/i]}, Parse::RecDescent::_tracefirst($text),
q{case_expression},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{/END/i})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:END)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN2__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/CASE/i searched_when_clause, or simple_when_clause /ELSE\\s+NULL/i, or /ELSE/i /END/i]<<},
Parse::RecDescent::_tracefirst($text),
q{case_expression},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{case_expression},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{case_expression},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{case_expression},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{case_expression},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::operator
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"operator"};
Parse::RecDescent::_trace(q{Trying rule: [operator]},
Parse::RecDescent::_tracefirst($_[1]),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/CONCAT/i, or '||']},
Parse::RecDescent::_tracefirst($_[1]),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{operator});
%item = (__RULE__ => q{operator});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [_alternation_1_of_production_1_of_rule_operator]},
Parse::RecDescent::_tracefirst($text),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_1_of_rule_operator($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [_alternation_1_of_production_1_of_rule_operator]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
$item{q{_alternation_1_of_production_1_of_rule_operator}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{>>Matched production: [/CONCAT/i, or '||']<<},
Parse::RecDescent::_tracefirst($text),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: ['/']},
Parse::RecDescent::_tracefirst($_[1]),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{operator});
%item = (__RULE__ => q{operator});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: ['/']},
Parse::RecDescent::_tracefirst($text),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\///)
{
$expectation->failed();
Parse::RecDescent::_trace(qq{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__STRING1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: ['/']<<},
Parse::RecDescent::_tracefirst($text),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: ['*']},
Parse::RecDescent::_tracefirst($_[1]),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[2];
$text = $_[1];
my $_savetext;
@item = (q{operator});
%item = (__RULE__ => q{operator});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: ['*']},
Parse::RecDescent::_tracefirst($text),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\*//)
{
$expectation->failed();
Parse::RecDescent::_trace(qq{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__STRING1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: ['*']<<},
Parse::RecDescent::_tracefirst($text),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: ['+']},
Parse::RecDescent::_tracefirst($_[1]),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[3];
$text = $_[1];
my $_savetext;
@item = (q{operator});
%item = (__RULE__ => q{operator});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: ['+']},
Parse::RecDescent::_tracefirst($text),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\+//)
{
$expectation->failed();
Parse::RecDescent::_trace(qq{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__STRING1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: ['+']<<},
Parse::RecDescent::_tracefirst($text),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: ['-']},
Parse::RecDescent::_tracefirst($_[1]),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[4];
$text = $_[1];
my $_savetext;
@item = (q{operator});
%item = (__RULE__ => q{operator});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: ['-']},
Parse::RecDescent::_tracefirst($text),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\-//)
{
$expectation->failed();
Parse::RecDescent::_trace(qq{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__STRING1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: ['-']<<},
Parse::RecDescent::_tracefirst($text),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{operator},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{operator},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{operator},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{operator},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_2_of_rule_type
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"_alternation_1_of_production_2_of_rule_type"};
Parse::RecDescent::_trace(q{Trying rule: [_alternation_1_of_production_2_of_rule_type]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_2_of_rule_type},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/INSERT/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_2_of_rule_type},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_2_of_rule_type});
%item = (__RULE__ => q{_alternation_1_of_production_2_of_rule_type});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/INSERT/i]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_type},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:INSERT)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/INSERT/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_type},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/DELETE/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_2_of_rule_type},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_2_of_rule_type});
%item = (__RULE__ => q{_alternation_1_of_production_2_of_rule_type});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/DELETE/i]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_type},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:DELETE)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/DELETE/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_type},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/UPDATE/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_2_of_rule_type},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[2];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_2_of_rule_type});
%item = (__RULE__ => q{_alternation_1_of_production_2_of_rule_type});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/UPDATE/i]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_type},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:UPDATE)//i)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/UPDATE/i]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_2_of_rule_type},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_2_of_rule_type},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{_alternation_1_of_production_2_of_rule_type},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{_alternation_1_of_production_2_of_rule_type},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{_alternation_1_of_production_2_of_rule_type},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_8_of_rule_sysibm_function
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"_alternation_1_of_production_8_of_rule_sysibm_function"};
Parse::RecDescent::_trace(q{Trying rule: [_alternation_1_of_production_8_of_rule_sysibm_function]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_8_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/CONCAT/]},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_8_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_8_of_rule_sysibm_function});
%item = (__RULE__ => q{_alternation_1_of_production_8_of_rule_sysibm_function});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: [/CONCAT/]}, Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_8_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A(?:CONCAT)//)
{
$expectation->failed();
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__PATTERN1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: [/CONCAT/]<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_8_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: ['||']},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_8_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{_alternation_1_of_production_8_of_rule_sysibm_function});
%item = (__RULE__ => q{_alternation_1_of_production_8_of_rule_sysibm_function});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying terminal: ['||']},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_8_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$lastsep = "";
$expectation->is(q{})->at($text);
unless ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and $text =~ s/\A\|\|//)
{
$expectation->failed();
Parse::RecDescent::_trace(qq{<>},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
last;
}
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
. $& . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
push @item, $item{__STRING1__}=$&;
Parse::RecDescent::_trace(q{>>Matched production: ['||']<<},
Parse::RecDescent::_tracefirst($text),
q{_alternation_1_of_production_8_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{_alternation_1_of_production_8_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{_alternation_1_of_production_8_of_rule_sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{_alternation_1_of_production_8_of_rule_sysibm_function},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{_alternation_1_of_production_8_of_rule_sysibm_function},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::sequence_reference
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"sequence_reference"};
Parse::RecDescent::_trace(q{Trying rule: [sequence_reference]},
Parse::RecDescent::_tracefirst($_[1]),
q{sequence_reference},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [nextval_expression]},
Parse::RecDescent::_tracefirst($_[1]),
q{sequence_reference},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{sequence_reference});
%item = (__RULE__ => q{sequence_reference});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [nextval_expression]},
Parse::RecDescent::_tracefirst($text),
q{sequence_reference},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::nextval_expression($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{sequence_reference},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [nextval_expression]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{sequence_reference},
$tracelevel)
if defined $::RD_TRACE;
$item{q{nextval_expression}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{>>Matched production: [nextval_expression]<<},
Parse::RecDescent::_tracefirst($text),
q{sequence_reference},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [prevval_expression]},
Parse::RecDescent::_tracefirst($_[1]),
q{sequence_reference},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[1];
$text = $_[1];
my $_savetext;
@item = (q{sequence_reference});
%item = (__RULE__ => q{sequence_reference});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [prevval_expression]},
Parse::RecDescent::_tracefirst($text),
q{sequence_reference},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::prevval_expression($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($text),
q{sequence_reference},
$tracelevel)
if defined $::RD_TRACE;
$expectation->failed();
last;
}
Parse::RecDescent::_trace(q{>>Matched subrule: [prevval_expression]<< (return value: [}
. $_tok . q{]},
Parse::RecDescent::_tracefirst($text),
q{sequence_reference},
$tracelevel)
if defined $::RD_TRACE;
$item{q{prevval_expression}} = $_tok;
push @item, $_tok;
}
Parse::RecDescent::_trace(q{>>Matched production: [prevval_expression]<<},
Parse::RecDescent::_tracefirst($text),
q{sequence_reference},
$tracelevel)
if defined $::RD_TRACE;
$_matched = 1;
last;
}
unless ( $_matched || defined($return) || defined($score) )
{
$_[1] = $text; # NOT SURE THIS IS NEEDED
Parse::RecDescent::_trace(q{<>},
Parse::RecDescent::_tracefirst($_[1]),
q{sequence_reference},
$tracelevel)
if defined $::RD_TRACE;
return undef;
}
if (!defined($return) && defined($score))
{
Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
q{sequence_reference},
$tracelevel)
if defined $::RD_TRACE;
$return = $score_return;
}
splice @{$thisparser->{errors}}, $err_at;
$return = $item[$#item] unless defined $return;
if (defined $::RD_TRACE)
{
Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} .
$return . q{])}, "",
q{sequence_reference},
$tracelevel);
Parse::RecDescent::_trace(q{(consumed: [} .
Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
Parse::RecDescent::_tracefirst($text),
, q{sequence_reference},
$tracelevel)
}
$_[1] = $text;
return $return;
}
# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args)
sub Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::sysibm_function
{
my $thisparser = $_[0];
use vars q{$tracelevel};
local $tracelevel = ($tracelevel||0)+1;
$ERRORS = 0;
my $thisrule = $thisparser->{"rules"}{"sysibm_function"};
Parse::RecDescent::_trace(q{Trying rule: [sysibm_function]},
Parse::RecDescent::_tracefirst($_[1]),
q{sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
my $err_at = @{$thisparser->{errors}};
my $score;
my $score_return;
my $_tok;
my $return = undef;
my $_matched=0;
my $commit=0;
my @item = ();
my %item = ();
my $repeating = defined($_[2]) && $_[2];
my $_noactions = defined($_[3]) && $_[3];
my @arg = defined $_[4] ? @{ &{$_[4]} } : ();
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
my $expectation = new Parse::RecDescent::Expectation($thisrule->expected());
$expectation->at($_[1]);
my $thisline;
tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
while (!$_matched && !$commit)
{
Parse::RecDescent::_trace(q{Trying production: [/ABS/i, or /ABSVAL/i]},
Parse::RecDescent::_tracefirst($_[1]),
q{sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
my $thisprod = $thisrule->{"prods"}[0];
$text = $_[1];
my $_savetext;
@item = (q{sysibm_function});
%item = (__RULE__ => q{sysibm_function});
my $repcount = 0;
Parse::RecDescent::_trace(q{Trying subrule: [_alternation_1_of_production_1_of_rule_sysibm_function]},
Parse::RecDescent::_tracefirst($text),
q{sysibm_function},
$tracelevel)
if defined $::RD_TRACE;
if (1) { no strict qw{refs};
$expectation->is(q{})->at($text);
unless (defined ($_tok = Parse::RecDescent::SQL::Translator::Parser::DB2::Grammar::_alternation_1_of_production_1_of_rule_sysibm_function($thisparser,$text,$repeating,$_noactions,sub { \@arg })))
{
Parse::RecDescent::_trace(q{<