File Coverage

blib/lib/Rosetta/Utility/SQLBuilder.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

#!perl
use 5.008001; use utf8; use strict; use warnings;

use only 'Locale::KeyedText' => '1.6.0-';
use only 'Rosetta::Model' => '0.71.0-';

package Rosetta::Utility::SQLBuilder;
use version; our $VERSION = qv('0.22.0');

use only 'List::MoreUtils' => '0.12-', qw( all );

######################################################################
######################################################################

# Names of properties for objects of the Rosetta::Utility::SQLBuilder class are
# declared here:
# This set of properties are generally set once at the start of a
# SQLBuilder object's life and aren't changed later, since they are
# generally static configuration data.
my $PROP_POSIT_HPRMS = 'posit_hprms';
    # boolean; true if host params are positional; false if named
my $PROP_IDENT_STYLE = 'ident_style';
    # enum char str; style of SQL identifiers
my $PROP_IDENT_QUOTC = 'ident_quotc';
    # character; character used to delimit YD_CS identifiers with
my $PROP_DATA_TYPES  = 'data_types' ;
    # hash ref
my $PROP_ORA_SEQ_USAGE = 'ora_seq_usage';
    # boolean; true if sequence usage in Oracle style
my $PROP_ORA_ROUTINES = 'ora_routines';
    # boolean; true to declare routines in Oracle style
my $PROP_INLINE_SUBQ = 'inline_subq';
    # boolean; true to inline all subq, false if "with" supported
my $PROP_INLINE_DOMAIN = 'inline_domain';
    # boolean; true inl data type, false named domains supp
my $PROP_SINGLE_SCHEMA = 'single_schema';
    # boolean; true to emulate mult schemas in single schema
my $PROP_SS_JOIN_CHARS = 'ss_join_chars';
    # char str; join schema name + sch obj name with this
my $PROP_EMUL_SUBQUERY = 'emul_subquery';
    # boolean; true to emulate subqueries with temp tables
my $PROP_EMUL_COMPOUND = 'emul_compound';
    # boolean; true to emulate unions etc with tt, joins
my $PROP_ET_JOIN_CHARS = 'et_join_chars';
    # char str; join parts of temp table names for emulations

# Here are more Rosetta::Utility::SQLBuilder object properties:
# Each of these contains either very short term configuration options
# (meant to have the life of about one external build* method call) that
# are only set externally as usual, or some may also be set or changed by
# SQLBuilder code, and can be used effectively as extra output from the
# build* method; they maintain state for a build* invocation.
my $PROP_MAKE_HPRMS = 'make_hprms';
    # boolean; true when routine vars are host params, false when not
my $PROP_PHP_MAP_ARY = 'php_map_ary';
    # array ref; holds state for host param map  of current sql code
my $PROP_UNWRAP_VIEWS = 'unwrap_views';
    # boolean; true to use original src names, false for correl

# Allowed values of the $PROP_IDENT_STYLE string.
my $IDST_YD_CS    = 'YD_CS'   ;
    # identifiers are delimited, case-sensitive
my $IDST_ND_CI_UP = 'ND_CI_UP';
    # identifiers are non-delimited, case-insensitive, uppercased
my $IDST_ND_CI_DN = 'ND_CI_DN';
    # identifiers are non-delimited, case-insensitive, lowercased

# Names of specific data types, used as keys in $PROP_DATA_TYPES hash.
my $DT_NUM_INT_8  = 'NUM_INT_8' ;
    # what signed ints up to  8 bits are stored as
my $DT_NUM_INT_16 = 'NUM_INT_16';
    # what signed ints up to 16 bits are stored as
my $DT_NUM_INT_24 = 'NUM_INT_24';
    # what signed ints up to 24 bits are stored as
my $DT_NUM_INT_32 = 'NUM_INT_32';
    # what signed ints up to 32 bits are stored as
my $DT_NUM_INT_64 = 'NUM_INT_64';
    # what signed ints up to 64 bits are stored as
my $DT_NUM_INT_128 = 'NUM_INT_128';
    # what signed ints up to 128 bits are stored as
my $DT_NUM_INT_LG = 'NUM_INT_LG';
    # what signed ints larger than 128 bits are stored as
my $DT_NUM_EXA_WS = 'NUM_EXA_WS';
    # an exact non-integer num; use when 'scale' is defined
my $DT_NUM_EXA_NS = 'NUM_EXA_NS';
    # an exact non-integer num; use when 'scale' not defined
my $DT_NUM_APR_32 = 'NUM_APR_32';
    # what floating-point nums up to 32 bits are stored as
my $DT_NUM_APR_64 = 'NUM_APR_64';
    # what floating-point nums up to 64 bits are stored as
my $DT_NUM_APR_128 = 'NUM_APR_128';
    # what floating-point nums up to 128 bits are stored as
my $DT_NUM_APR_LG = 'NUM_APR_LG';
    # what floating-point nums larger than 128 bits are stored as
my $DT_NUM_UNS_SFX = 'NUM_UNS_SFX';
    # suffix added to numeric type decls to make unsigned
my $DT_STR_BIT_255 = 'STR_BIT_255';
    # storage for binary data up to 255 bytes, var-size
my $DT_STR_BIT_255F = 'STR_BIT_255F';
    # storage for binary data up to 255 bytes, fixed-size
my $DT_STR_BIT_2K = 'STR_BIT_2K';
    # storage for binary data up to 2000 bytes, var-size
my $DT_STR_BIT_2KF = 'STR_BIT_2KF';
    # storage for binary data up to 2000 bytes, fixed-size
my $DT_STR_BIT_4K = 'STR_BIT_4K';
    # storage for binary data up to 4000 bytes, var-size
my $DT_STR_BIT_4KF = 'STR_BIT_4KF';
    # storage for binary data up to 4000 bytes, fixed-size
my $DT_STR_BIT_32K = 'STR_BIT_32K';
    # storage for binary data up to 32767 bytes
my $DT_STR_BIT_65K = 'STR_BIT_65K';
    # storage for binary data up to 65535 bytes
my $DT_STR_BIT_16M = 'STR_BIT_16M';
    # storage for binary data up to 16777215 bytes
my $DT_STR_BIT_2G = 'STR_BIT_2G';
    # storage for binary data up to 2147483647 bytes
my $DT_STR_BIT_4G = 'STR_BIT_4G';
    # storage for binary data up to 4294967295 bytes
my $DT_STR_BIT_LG = 'STR_BIT_LG';
    # storage for larger binary data (over 4GB)
my $DT_STR_CHAR_255 = 'STR_CHAR_255';
    # storage for character data up to 255 chars, var-size
my $DT_STR_CHAR_255F = 'STR_CHAR_255F';
    # storage for character data up to 255 chars, fixed-size
my $DT_STR_CHAR_2K = 'STR_CHAR_2K';
    # storage for character data up to 2000 chars, var-size
my $DT_STR_CHAR_2KF = 'STR_CHAR_2KF';
    # storage for character data up to 2000 chars, fixed-size
my $DT_STR_CHAR_4K = 'STR_CHAR_4K';
    # storage for character data up to 4000 chars, var-size
my $DT_STR_CHAR_4KF = 'STR_CHAR_4KF';
    # storage for character data up to 4000 chars, fixed-size
my $DT_STR_CHAR_32K = 'STR_CHAR_32K';
    # storage for character data up to 32767 chars
my $DT_STR_CHAR_65K = 'STR_CHAR_65K';
    # storage for character data up to 65535 chars
my $DT_STR_CHAR_16M = 'STR_CHAR_16M';
    # storage for character data up to 16777215 chars
my $DT_STR_CHAR_2G = 'STR_CHAR_2G';
    # storage for character data up to 2147483647 chars
my $DT_STR_CHAR_4G = 'STR_CHAR_4G';
    # storage for character data up to 4294967295 chars
my $DT_STR_CHAR_LG = 'STR_CHAR_LG';
    # storage for larger character data (over 4GB)
my $DT_BOOLEAN = 'BOOLEAN';
    # type can only be TRUE,FALSE,UNKNOWN
my $DT_BOOL_USE_NUMS = 'BOOL_USE_NUMS';
    # if true, give 1,0,undef for above rather than words
my $DT_DATM_FULL = 'DATM_FULL';
    # storage for full datetime/timestamp
my $DT_DATM_DATE = 'DATM_DATE';
    # storage for date only
my $DT_DATM_TIME = 'DATM_TIME';
    # storage for time only
my $DT_INTRVL_YM = 'INTRVL_YM';
    # storage for year-month interval
my $DT_INTRVL_DT = 'INTRVL_DT';
    # storage for day-time (day-hour-min-sec) interval
my $DT_HAS_ENUM_TYPE = 'HAS_ENUM_TYPE';
    # boolean; if true use ENUM, if false, use CHECK

# Miscellaneous constant values
my $EMPTY_STR = q{};
my $INFINITY = 1_000_000_000_000_000_000; # A hack to mean 'unlimited size'

######################################################################

sub new {
    my ($class) = @_;
    my $builder = bless {}, ref $class || $class;

    $builder->{$PROP_POSIT_HPRMS} = 0;
    $builder->{$PROP_IDENT_STYLE} = $IDST_YD_CS;
    $builder->{$PROP_IDENT_QUOTC} = q{"}; # doublequote given in ANSI example
        # set to '"' for Oracle and FireBird, '`' for MySQL
    $builder->{$PROP_DATA_TYPES} = $builder->_get_default_data_type_customizations();
    $builder->{$PROP_ORA_SEQ_USAGE} = 0;
    $builder->{$PROP_ORA_ROUTINES} = 0;
    $builder->{$PROP_INLINE_SUBQ} = 0;
    $builder->{$PROP_INLINE_DOMAIN} = 0;
    $builder->{$PROP_SINGLE_SCHEMA} = 0;
    $builder->{$PROP_SS_JOIN_CHARS} = '__'; # double underscore should normally be unique
        # unique value is necessary to reliably reverse-engineer model from a database schema
    $builder->{$PROP_EMUL_SUBQUERY} = 0;
    $builder->{$PROP_EMUL_COMPOUND} = 0;
    $builder->{$PROP_ET_JOIN_CHARS} = '__';

    $builder->{$PROP_MAKE_HPRMS} = 0;
    $builder->{$PROP_PHP_MAP_ARY} = [];
    $builder->{$PROP_UNWRAP_VIEWS} = 0;

    return $builder;
}

sub _get_default_data_type_customizations {
    return {
        $DT_NUM_INT_8  => 'SMALLINT', # standard; 'TINYINT' for MySQL; 'NUMBER' for Oracle
        $DT_NUM_INT_16 => 'SMALLINT', # for SQL89, MySQL, Pg; 'NUMBER' for Oracle
        $DT_NUM_INT_24 => 'INTEGER' , # standard; 'MEDIUMINT' for MySQL; 'NUMBER' for Oracle
        $DT_NUM_INT_32 => 'INTEGER' , # for SQL92, MySQL, Pg; 'NUMBER' for Oracle
        $DT_NUM_INT_64 => 'BIGINT'  , # for SQL:2003 (but not 99), MySQL, Pg; 'NUMBER' for Oracle
        $DT_NUM_INT_128 => 'DECIMAL({np},0)', # standard, MySQL; 'NUMBER' for Oracle
        $DT_NUM_INT_LG => 'DECIMAL({np},0)' , # standard, MySQL; 'RAW' for Oracle
        $DT_NUM_EXA_WS => 'DECIMAL({np},{ns})', # for SQL99, MySQL, Pg; 'NUMBER' for Oracle
        $DT_NUM_EXA_NS => 'DECIMAL({np})'     , # for SQL99, MySQL, Pg; 'NUMBER' for Oracle
        $DT_NUM_APR_32 => 'FLOAT({np})' , # standard, MySQL; 'NUMBER' for Oracle
        $DT_NUM_APR_64 => 'FLOAT({np})' , # standard; 'DOUBLE' for MySQL; 'NUMBER' for Oracle
        $DT_NUM_APR_128 => 'FLOAT({np})', # 'DECIMAL' for MySQL?; 'NUMBER' for Oracle
        $DT_NUM_APR_LG => 'FLOAT({np})' , # 'DECIMAL' for MySQL?; 'RAW' for Oracle
        $DT_NUM_UNS_SFX => 'UNSIGNED', # for MySQL
            # Note: the SQL:2003 standard says that exact numerics can take precision and scale
            # arguments (if NUMERIC or DECIMAL; precision is mandatory, scale is optional),
            # approximate ones take precision only (if FLOAT; REAL and DOUBLE do not take anything),
            # integers (INTEGER, SMALLINT) can not take either.
        $DT_STR_BIT_255 => 'BIT VARYING({mo})', # standard (or 'VARBIT'?); 'RAW' for Oracle; 'TINYBLOB' for MySQL
        $DT_STR_BIT_255F => 'BIT({mo})', # standard; 'RAW' for Oracle; 'TINYBLOB' for MySQL
            # According to SQL:2003 Foundation, Annex E (p1173), there had been data types
            # called 'BIT' and 'BIT VARYING' in SQL:1999, but they are removed in SQL:2003.
        $DT_STR_BIT_2K  => 'BLOB({mo})', # for MySQL; 'RAW' for Oracle
        $DT_STR_BIT_2KF => 'BLOB({mo})', # for MySQL; 'RAW' for Oracle
        $DT_STR_BIT_4K  => 'BLOB({mo})', # for MySQL, Oracle
        $DT_STR_BIT_4KF => 'BLOB({mo})', # for MySQL, Oracle
        $DT_STR_BIT_32K => 'BLOB({mo})', # for MySQL, Oracle
        $DT_STR_BIT_65K => 'BLOB({mo})', # for MySQL, Oracle
        $DT_STR_BIT_16M => 'BLOB({mo})', # standard, Oracle; 'MEDIUMBLOB' for MySQL
        $DT_STR_BIT_2G  => 'BLOB({mo})', # standard, Oracle; 'LONGBLOB' for MySQL
        $DT_STR_BIT_4G  => 'BLOB({mo})', # standard, Oracle; 'LONGBLOB' for MySQL
        $DT_STR_BIT_LG  => 'BLOB({mo})', # standard
        $DT_STR_CHAR_255 => 'VARCHAR({mc})', # for MySQL; 'VARCHAR2' for Oracle
        $DT_STR_CHAR_255F => 'CHAR({mc})'  , # for MySQL, Oracle
        $DT_STR_CHAR_2K  => 'VARCHAR({mc})', # 'TEXT' for MySQL; 'VARCHAR2' for Oracle
        $DT_STR_CHAR_2KF => 'CHAR({mc})'   , # 'TEXT' for MySQL; 'CHAR' for Oracle
        $DT_STR_CHAR_4K  => 'VARCHAR({mc})', # 'TEXT' for MySQL; 'VARCHAR2' for Oracle
        $DT_STR_CHAR_4KF => 'CHAR({mc})'   , # 'TEXT' for MySQL; 'VARCHAR2' for Oracle
        $DT_STR_CHAR_32K => 'VARCHAR({mc})', # 'VARCHAR2'/'CLOB' for Oracle; 'TEXT' for MySQL
        $DT_STR_CHAR_65K => 'VARCHAR({mc})', # standard, Oracle; 'TEXT' for MySQL
        $DT_STR_CHAR_16M => 'CLOB({mc})'   , # standard, Oracle; 'MEDIUMTEXT' for MySQL
        $DT_STR_CHAR_2G  => 'CLOB({mc})'   , # standard, Oracle; 'LONGTEXT' for MySQL
        $DT_STR_CHAR_4G  => 'CLOB({mc})'   , # standard, Oracle; 'LONGTEXT' for MySQL
        $DT_STR_CHAR_LG  => 'CLOB({mc})'   , # standard
        $DT_BOOLEAN => 'BOOLEAN', # standard; Oracle uses 'CHAR(1)'; MySQL 'TINYINT' or 'BIT'
        $DT_BOOL_USE_NUMS => 0, # SQL:2003; not sure what dbs require nums
        $DT_DATM_FULL => 'TIMESTAMP', # standard; 'DATETIME' for MySQL; Oracle uses 'DATE'
        $DT_DATM_DATE => 'DATE'     , # standard, Oracle
        $DT_DATM_TIME => 'TIME'     , # standard
        $DT_INTRVL_YM => 'INTERVAL', # still need to add ''
        $DT_INTRVL_DT => 'INTERVAL', # still need to add ''
        $DT_HAS_ENUM_TYPE => 0, # for standard, Oracle use CHECK; MySQL supports ENUM
    };
}

######################################################################

sub positional_host_params {
    my ($builder, $new_value) = @_;
    if (defined $new_value) {
        $builder->{$PROP_POSIT_HPRMS} = $new_value;
    }
    return $builder->{$PROP_POSIT_HPRMS};
}

######################################################################

sub identifier_style {
    my ($builder, $new_value) = @_;
    if (defined $new_value) {
        $builder->_throw_error_message( 'ROS_U_SB_IDENT_STYLE_ARG_INVAL',
            { 'EXPVLS' => [$IDST_YD_CS,$IDST_ND_CI_UP,$IDST_ND_CI_DN], 'ARGVL' => $new_value } )
            if $new_value ne $IDST_YD_CS and $new_value ne $IDST_ND_CI_UP and $new_value ne $IDST_ND_CI_DN;
        $builder->{$PROP_IDENT_STYLE} = $new_value;
    }
    return $builder->{$PROP_IDENT_STYLE};
}

sub identifier_delimiting_char {
    my ($builder, $new_value) = @_;
    if (defined $new_value) {
        $builder->{$PROP_IDENT_QUOTC} = $new_value;
    }
    return $builder->{$PROP_IDENT_QUOTC};
}

######################################################################

sub get_data_type_customizations {
    my ($builder) = @_;
    return {%{$builder->{$PROP_DATA_TYPES}}};
}

sub set_data_type_customizations {
    my ($builder, $new_values) = @_;
    $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_UNDEF',
        { 'METH' => 'set_data_type_customizations', 'ARGNM' => 'NEW_VALUES' } )
        if !defined $new_values;
    $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_NO_HASH',
        { 'METH' => 'set_data_type_customizations', 'ARGNM' => 'NEW_VALUES', 'ARGVL' => $new_values } )
        if ref $new_values ne 'HASH';
    my $data_types = $builder->{$PROP_DATA_TYPES};
    while (my ($key, $value) = each %{$new_values}) {
        $data_types->{$key} = $value;
    }
}

sub reset_default_data_type_customizations {
    my ($builder) = @_;
    $builder->{$PROP_DATA_TYPES} = $builder->_get_default_data_type_customizations();
}

######################################################################

sub ora_style_seq_usage {
    my ($builder, $new_value) = @_;
    if (defined $new_value) {
        $builder->{$PROP_ORA_SEQ_USAGE} = $new_value;
    }
    return $builder->{$PROP_ORA_SEQ_USAGE};
}

sub ora_style_routines {
    my ($builder, $new_value) = @_;
    if (defined $new_value) {
        $builder->{$PROP_ORA_ROUTINES} = $new_value;
    }
    return $builder->{$PROP_ORA_ROUTINES};
}

######################################################################

sub inlined_subqueries {
    my ($builder, $new_value) = @_;
    if (defined $new_value) {
        $builder->{$PROP_INLINE_SUBQ} = $new_value;
    }
    return $builder->{$PROP_INLINE_SUBQ};
}

######################################################################

sub inlined_domains {
    my ($builder, $new_value) = @_;
    if (defined $new_value) {
        $builder->{$PROP_INLINE_DOMAIN} = $new_value;
    }
    return $builder->{$PROP_INLINE_DOMAIN};
}

######################################################################

sub flatten_to_single_schema {
    my ($builder, $new_value) = @_;
    if (defined $new_value) {
        $builder->{$PROP_SINGLE_SCHEMA} = $new_value;
    }
    return $builder->{$PROP_SINGLE_SCHEMA};
}

sub single_schema_join_chars {
    my ($builder, $new_value) = @_;
    if (defined $new_value) {
        $builder->{$PROP_SS_JOIN_CHARS} = $new_value;
    }
    return $builder->{$PROP_SS_JOIN_CHARS};
}

######################################################################

sub emulate_subqueries {
    my ($builder, $new_value) = @_;
    if (defined $new_value) {
        $builder->{$PROP_EMUL_SUBQUERY} = $new_value;
    }
    return $builder->{$PROP_EMUL_SUBQUERY};
}

sub emulate_compound_queries {
    my ($builder, $new_value) = @_;
    if (defined $new_value) {
        $builder->{$PROP_EMUL_COMPOUND} = $new_value;
    }
    return $builder->{$PROP_EMUL_COMPOUND};
}

sub emulated_query_temp_table_join_chars {
    my ($builder, $new_value) = @_;
    if (defined $new_value) {
        $builder->{$PROP_ET_JOIN_CHARS} = $new_value;
    }
    return $builder->{$PROP_ET_JOIN_CHARS};
}

######################################################################

sub make_host_params {
    my ($builder, $new_value) = @_;
    if (defined $new_value) {
        $builder->{$PROP_MAKE_HPRMS} = $new_value;
    }
    return $builder->{$PROP_MAKE_HPRMS};
}

######################################################################

sub get_positional_host_param_map_array {
    my ($builder) = @_;
    return [@{$builder->{$PROP_PHP_MAP_ARY}}];
}

sub clear_positional_host_param_map_array {
    my ($builder) = @_;
    @{$builder->{$PROP_PHP_MAP_ARY}} = ();
}

######################################################################

sub unwrap_views {
    my ($builder, $new_value) = @_;
    if (defined $new_value) {
        $builder->{$PROP_UNWRAP_VIEWS} = $new_value;
    }
    return $builder->{$PROP_UNWRAP_VIEWS};
}

######################################################################

sub quote_literal {
    my ($builder, $literal, $base_type) = @_;
    return $base_type eq 'NUM_INT'  ? $builder->quote_integer_literal( $literal )
         : $base_type eq 'NUM_EXA'  ? $builder->quote_numeric_literal( $literal )
         : $base_type eq 'NUM_APR'  ? $builder->quote_numeric_literal( $literal )
         : $base_type eq 'STR_BIT'  ? $builder->quote_hex_string_literal( $literal )
         : $base_type eq 'STR_CHAR' ? $builder->quote_char_string_literal( $literal )
         : $base_type eq 'BOOLEAN'  ? $builder->quote_boolean_literal( $literal )
         :                            $builder->quote_char_string_literal( $literal ) # treat misc/date/interval as char
         ;
}

sub quote_char_string_literal {
    my ($builder, $literal) = @_;
    $literal =~ s/'/''/xg;
    # MySQL also supports escaping of NULs and control characters, like with "\0"
    return q{'} . $literal . q{'};
    # Input of "Perl" becomes output of "'Perl'".
    # More work is needed.  See SQL:2003, 02-Foundation, 5.3  (pg 143).
    # We need to support both
    # and .
}

sub quote_bin_string_literal {
    my ($builder, $literal) = @_;
    return q{B'} . (join $EMPTY_STR, map { unpack 'B8', $_ } split $EMPTY_STR, $literal) . q{'};
    # Input of "Perl" becomes output of "B'01010000011001010111001001101100'".
}

sub quote_hex_string_literal {
    my ($builder, $literal) = @_;
    return q{X'} . (uc join $EMPTY_STR, map { unpack 'H2', $_ } split $EMPTY_STR, $literal) . q{'};
    # Input of "Perl" becomes output of "X'5065726C'".
}

sub quote_integer_literal {
    my ($builder, $literal) = @_;
    return q{'} . (int $literal) . q{'}; # quotes make MySQL ENUMS work correctly
}

sub quote_numeric_literal {
    my ($builder, $literal) = @_;
    return q{'} . (0 + $literal) . q{'}; # quotes make MySQL ENUMS work correctly
}

sub quote_boolean_literal {
    my ($builder, $literal) = @_;
    if ($builder->{$PROP_DATA_TYPES}->{$DT_BOOL_USE_NUMS}) {
        return !defined $literal ? 'NULL'
             : $literal          ? 1
             :                     0
             ;
    }
    else {
        return !defined $literal ? 'UNKNOWN'
             : $literal          ? 'TRUE'
             :                     'FALSE'
             ;
    }
}

######################################################################

sub quote_identifier {
    # SQL:2003, 5.2 " and " (p134)
    # SQL:2003, 5.4 "Names and identifiers" (p151)
    my ($builder, $name) = @_;
    if ($builder->{$PROP_IDENT_STYLE} eq $IDST_YD_CS) {
        #  ::=
        my $quotc = $builder->{$PROP_IDENT_QUOTC};
        $name =~ s/$quotc/$quotc$quotc/xg;
        $name = $quotc . $name . $quotc;
    }
    elsif ($builder->{$PROP_IDENT_STYLE} eq $IDST_ND_CI_UP) {
        $name = uc $name;
        $name =~ s/[^A-Z0-9_]//xg;
    }
    elsif ($builder->{$PROP_IDENT_STYLE} eq $IDST_ND_CI_DN) {
        $name = lc $name;
        $name =~ s/[^a-z0-9_]//xg;
    }
    else {} # we should never get here
    return $name;
    # More work is needed.
    # We need to support  and
    # and ; only first two are done now.
}

sub build_identifier_element {
    # This function is for getting the unqualified name of a non-schema object,
    # such as a local variable.
    my ($builder, $object_node) = @_;
    $builder->_assert_arg_node_type( 'build_identifier_element',
        'OBJECT_NODE', [], $object_node );
    return $builder->quote_identifier( $object_node->get_attribute( 'si_name' ) );
}

sub build_identifier_host_parameter_name {
    # SQL:2003, 4.29 "Host parameters" (pp90,91,92)
    # SQL:2003, 5.4 "Names and identifiers" (pp151,152)
    # SQL:2003 Foundation page 152 says:  ::=
    my ($builder, $routine_arg_node) = @_;
    $builder->_assert_arg_node_type( 'build_identifier_host_parameter_name',
        'ROUTINE_ARG_NODE', ['routine_arg'], $routine_arg_node );
    my $routine_arg_name = $routine_arg_node->get_attribute( 'si_name' );
    if ($builder->{$PROP_POSIT_HPRMS}) {
        # Insert positional host parameter/placeholder.
        push @{$builder->{$PROP_PHP_MAP_ARY}}, $routine_arg_name;
        return '?'; # DBI-style positional place-holders, and apparently SQL:2003 standard also.
    }
    else {
        # Insert named host parameter/placeholder.
        return ':' . $builder->quote_identifier( $routine_arg_name );
        # This named style is in the SQL:1999 standard, apparently.  Oracle also uses it.
        # TODO: Add support for @foo (inst of :foo) host param names that SQL-Server, other dbs use.
    }
}

sub build_identifier_schema_or_app_obj {
    # SQL:2003, 6.6 "" (p183)
    # SQL:2003, 6.7 "" (p187)
    # fd=0; This function is for getting the name of an existing schema or temporary object that is not
    # being created or dropped, such as most of the times it is referred to.
    # fd=1; This function is for getting the name of a schema or temporary object to be
    # created or dropped, which may require you to be logged into the
    # schema being created in, and schema object names may have to be unqualified.
    # Temporary objects don't live in any schema and are only visible to the connection that made them.
    my ($builder, $object_node, $for_defn) = @_;
    $builder->_assert_arg_node_type( 'build_identifier_schema_or_app_obj',
        'OBJECT_NODE', ['scalar_domain','row_domain','sequence','table','view','routine'], $object_node );
    my $object_name = $object_node->get_attribute( 'si_name' );
    my $parent_node = $object_node->get_primary_parent_attribute();
    my $parent_name = $parent_node->get_attribute( 'si_name' );
    if ($parent_node->get_node_type() eq 'schema') {
        # If we get here then we are working with a long-lived schema object.
        # TODO: support for referencing into other catalogs
        if ($builder->{$PROP_SINGLE_SCHEMA}) {
            return $builder->quote_identifier(
                $parent_name . $builder->{$PROP_SS_JOIN_CHARS} . $object_name );
        }
        else {
            if ($for_defn) {
                return $builder->quote_identifier( $parent_name ) . '.'
                    . $builder->quote_identifier( $object_name );
                # SQL:2003 says declare with
                # Note that Oracle lets you opt prefix schema name when defining; don't know if standard does.
            }
            else {
                return $builder->quote_identifier( $parent_name ) . '.'
                    . $builder->quote_identifier( $object_name );
            }
        }
    }
    elsif ($parent_node->get_node_type() eq 'application') {
        # If we get here then we are working with a temporary object.
        if ($for_defn) {
            return $builder->quote_identifier( $object_name ); # caller adds TEMPORARY keyword later
        }
        else {
            # MODULE     ... how you ref local temp tables
            return 'MODULE.' . $builder->quote_identifier( $object_name );
        }
    }
    else {} # this function should never be called when parent is some other Node type
}

sub build_identifier_view_src_field {
    my ($builder, $view_src_field_node) = @_;
    $builder->_assert_arg_node_type( 'build_identifier_view_src_field',
        'VIEW_SRC_FIELD_NODE', ['view_src_field'], $view_src_field_node );
    my $row_dt_field_node = $view_src_field_node->get_attribute( 'si_match_field' );
    if ($builder->{$PROP_UNWRAP_VIEWS}) {
        # We are probably in the WHERE/etc clause of an INSERT|UPDATE|DELETE statement.
        # Assume IUD statement is against one source for now, so unqualified src col names are fine.
        return $builder->quote_identifier( $row_dt_field_node->get_attribute( 'si_name' ) );
    }
    else {
        # We are in a normal SELECT statement or view.
        # As usual, have fully qualified name to support multiple sources.
        my $view_src_node = $view_src_field_node->get_primary_parent_attribute();
        return $builder->quote_identifier( $view_src_node->get_attribute( 'si_name' ) ) . '.'
            . $builder->quote_identifier( $row_dt_field_node->get_attribute( 'si_name' ) );
    }
}

sub build_identifier_temp_table_for_emul {
    # This function is for getting the name of a temporary table that will be
    # used by this module when emulating sub-queries or compound queries, to
    # hold intermediate values.
    my ($builder, $inner_view_node) = @_;
    $builder->_assert_arg_node_type( 'build_identifier_temp_table_for_emul',
        'INNER_VIEW_NODE', ['view'], $inner_view_node );
    my @tt_name_parts = ();
    my $curr_node = $inner_view_node;
    push @tt_name_parts, $curr_node->get_attribute( 'si_name' );
    while ($curr_node->get_primary_parent_attribute()->get_node_type() eq 'view') {
        $curr_node = $curr_node->get_primary_parent_attribute();
        push @tt_name_parts, $curr_node->get_attribute( 'si_name' );
    }
#    while ($curr_node->get_primary_parent_attribute()->get_node_type() eq 'routine') {
#        $curr_node = $curr_node->get_primary_parent_attribute();
#        push @tt_name_parts, $curr_node->get_attribute( 'si_name' );
#    }
    $curr_node = $curr_node->get_primary_parent_attribute();
    push @tt_name_parts, $curr_node->get_attribute( 'si_name' );
    return $builder->quote_identifier(
        join $builder->{$PROP_ET_JOIN_CHARS}, @tt_name_parts );
}

######################################################################

sub build_expr {
    my ($builder, $expr_node) = @_;
    $builder->_assert_arg_node_type( 'build_expr',
        'EXPR_NODE', ['view_expr','routine_expr'], $expr_node );
    my $cont_type = $expr_node->get_attribute( 'cont_type' );
    if ($cont_type eq 'LIST') {
        return '(' . (join q{, }, map { $builder->build_expr( $_ ) }
            @{$expr_node->get_child_nodes()}) . ')';
    }
    else {
        if (my $valf_literal = $expr_node->get_attribute( 'valf_literal' )) {
            my $scalar_data_type_node = $builder->_scalar_data_type_of_node( $expr_node );
            return $builder->quote_literal( $valf_literal,
                $scalar_data_type_node->get_attribute( 'base_type' ) );
        }
        elsif (my $valf_src_field = $expr_node->get_attribute( 'valf_src_field' )) {
            return $builder->build_identifier_view_src_field( $valf_src_field );
        }
        elsif (my $valf_result_field = $expr_node->get_attribute( 'valf_result_field' )) {
            return $builder->build_identifier_element( $valf_result_field );
        }
        elsif (my $valf_p_view_arg = $expr_node->get_attribute( 'valf_p_view_arg' )) {
            return $builder->build_identifier_element( $valf_p_view_arg );
        }
        elsif (my $routine_item_node = $expr_node->get_attribute( 'valf_p_routine_item' )) {
            if ($routine_item_node->get_node_type() eq 'routine_arg' and $builder->{$PROP_MAKE_HPRMS}) {
                # We are currently within an application-side routine, so arg is an app host param.
                return $builder->build_identifier_host_parameter_name( $routine_item_node );
            }
            else {
                # We are *not* within an application-side routine, so arg is a compiled routine var, or is an in-rtn var.
                return $builder->build_identifier_element( $routine_item_node );
            }
        }
        elsif (my $sequence_node = $expr_node->get_attribute( 'valf_seq_next' )) {
            return $builder->build_expr_seq_next( $sequence_node );
        }
        elsif ($expr_node->get_attribute( 'valf_call_view' )) {
            return $builder->build_query_subquery( $expr_node );
        }
        elsif ($expr_node->get_attribute( 'valf_call_sroutine' )) {
            return $builder->build_expr_call_sroutine( $expr_node );
        }
        elsif ($expr_node->get_attribute( 'valf_call_uroutine' )) {
            return $builder->build_expr_call_uroutine( $expr_node );
        }
        else {}
    }
}

######################################################################

sub build_expr_scalar_data_type_defn { # SQL:2003, 6.1 "" (p161)
    my ($builder, $scalar_data_type_node) = @_;
    $builder->_assert_arg_node_type( 'build_expr_scalar_data_type_defn',
        'SCALAR_DATA_TYPE_NODE', ['scalar_data_type'], $scalar_data_type_node );

    my $base_type = $scalar_data_type_node->get_attribute( 'base_type' );
    my $num_precision = $scalar_data_type_node->get_attribute( 'num_precision' ) || 0;
    my $num_scale = $scalar_data_type_node->get_attribute( 'num_scale' ) || 0;
    my $num_octets = $scalar_data_type_node->get_attribute( 'num_octets' ) || 0;
    my $num_unsigned = $scalar_data_type_node->get_attribute( 'num_unsigned' ) || 0;
    my $max_octets = $scalar_data_type_node->get_attribute( 'max_octets' ) || 0;
    my $max_chars = $scalar_data_type_node->get_attribute( 'max_chars' ) || 0;
    my $store_fixed = $scalar_data_type_node->get_attribute( 'store_fixed' );
    my $char_enc = $scalar_data_type_node->get_attribute( 'char_enc' );
    my $trim_white = $scalar_data_type_node->get_attribute( 'trim_white' );
    my $uc_latin = $scalar_data_type_node->get_attribute( 'uc_latin' );
    my $lc_latin = $scalar_data_type_node->get_attribute( 'lc_latin' );
    my $pad_char = $scalar_data_type_node->get_attribute( 'pad_char' );
    my $trim_pad = $scalar_data_type_node->get_attribute( 'trim_pad' );
    my $calendar = $scalar_data_type_node->get_attribute( 'calendar' );
    my $range_min = $scalar_data_type_node->get_attribute( 'range_min' );
    my $range_max = $scalar_data_type_node->get_attribute( 'range_max' );
    my @allowed_values = map { $_->get_attribute( 'si_value' ) }
        @{$scalar_data_type_node->get_child_nodes( 'scalar_data_type_opt' )};
        # Note: ROS M guarantees that scalar_data_type_opt attrs have a defined value, though could be ''

    my $type_conv = $builder->{$PROP_DATA_TYPES};

    my $sql = $EMPTY_STR;

    if ($base_type eq 'NUM_INT') {
        $num_precision <= 0 and $num_precision = $INFINITY;
        $num_octets <= 0 and $num_octets = $INFINITY;
        if ($num_precision <= 2 or $num_octets <= 1) {
            $sql = $type_conv->{$DT_NUM_INT_8};
        }
        elsif ($num_precision <= 4 or $num_octets <= 2) {
            $sql = $type_conv->{$DT_NUM_INT_16};
        }
        elsif ($num_precision <= 6 or $num_octets <= 3) {
            $sql = $type_conv->{$DT_NUM_INT_24};
        }
        elsif ($num_precision <= 9 or $num_octets <= 4) {
            $sql = $type_conv->{$DT_NUM_INT_32};
        }
        elsif ($num_precision <= 18 or $num_octets <= 8) {
            $sql = $type_conv->{$DT_NUM_INT_64};
        }
        elsif ($num_precision <= 38 or $num_octets <= 16) {
            $sql = $type_conv->{$DT_NUM_INT_128};
        }
        else {
            $sql = $type_conv->{$DT_NUM_INT_LG};
        }
        if ($num_precision < $INFINITY) {
            $sql = $builder->substitute_macros( $sql, { 'np' => $num_precision } );
        }
        if ($num_unsigned) {
            $sql .= ' ' . $type_conv->{$DT_NUM_UNS_SFX};
        }
    }

    if ($base_type eq 'NUM_EXA') {
        if (defined $num_scale) {
            $sql = $type_conv->{$DT_NUM_EXA_WS};
        }
        else {
            $sql = $type_conv->{$DT_NUM_EXA_NS};
        }
        $sql = $builder->substitute_macros( $sql, { 'np' => $num_precision, 'ns' => $num_scale } );
        if ($num_unsigned) {
            $sql .= ' ' . $type_conv->{$DT_NUM_UNS_SFX};
        }
    }

    if ($base_type eq 'NUM_APR') {
        $num_precision <= 0 and $num_precision = $INFINITY;
        $num_octets <= 0 and $num_octets = $INFINITY;
        if ($num_precision <= 9 or $num_octets <= 4) {
            $sql = $type_conv->{$DT_NUM_APR_32};
        }
        elsif ($num_precision <= 18 or $num_octets <= 8) {
            $sql = $type_conv->{$DT_NUM_APR_64};
        }
        elsif ($num_precision <= 38 or $num_octets <= 16) {
            $sql = $type_conv->{$DT_NUM_APR_128};
        }
        else {
            $sql = $type_conv->{$DT_NUM_APR_LG};
        }
        if ($num_precision < $INFINITY) {
            $sql = $builder->substitute_macros( $sql, { 'np' => $num_precision, 'ns' => $num_scale } );
        }
        if ($num_unsigned) {
            $sql .= ' ' . $type_conv->{$DT_NUM_UNS_SFX};
        }
    }

    if ($base_type eq 'STR_BIT') {
        $max_octets <= 0 and $max_octets = $INFINITY;
        if ($max_octets <= 255) {
            $sql = $store_fixed ? $type_conv->{$DT_STR_BIT_255F}
                 :                $type_conv->{$DT_STR_BIT_255}
                 ;
        }
        elsif ($max_octets <= 2000) {
            $sql = $store_fixed ? $type_conv->{$DT_STR_BIT_2KF}
                 :                $type_conv->{$DT_STR_BIT_2K}
                 ;
        }
        elsif ($max_octets <= 4000) {
            $sql = $store_fixed ? $type_conv->{$DT_STR_BIT_4KF}
                 :                $type_conv->{$DT_STR_BIT_4K}
                 ;
        }
        elsif ($max_octets <= (2**15-1)) {
            $sql = $type_conv->{$DT_STR_BIT_32K};
        }
        elsif ($max_octets <= (2**16-1)) {
            $sql = $type_conv->{$DT_STR_BIT_65K};
        }
        elsif ($max_octets <= (2**24-1)) {
            $sql = $type_conv->{$DT_STR_BIT_16M};
        }
        elsif ($max_octets <= (2**31-1)) {
            $sql = $type_conv->{$DT_STR_BIT_2G};
        }
        elsif ($max_octets <= (2**32-1)) {
            $sql = $type_conv->{$DT_STR_BIT_4G};
        }
        else {
            $sql = $type_conv->{$DT_STR_BIT_LG};
        }
        if ($max_octets < $INFINITY) {
            $sql = $builder->substitute_macros( $sql, { 'mo' => $max_octets } );
        }
    }

    if ($base_type eq 'STR_CHAR') {
        $max_chars <= 0 and $max_chars = $INFINITY;
        if ($max_chars <= 255) {
            $sql = $store_fixed ? $type_conv->{$DT_STR_CHAR_255F}
                 :                $type_conv->{$DT_STR_CHAR_255}
                 ;
        }
        elsif ($max_chars <= 2000) {
            $sql = $store_fixed ? $type_conv->{$DT_STR_CHAR_2KF}
                 :                $type_conv->{$DT_STR_CHAR_2K}
                 ;
        }
        elsif ($max_chars <= 4000) {
            $sql = $store_fixed ? $type_conv->{$DT_STR_CHAR_4KF}
                 :                $type_conv->{$DT_STR_CHAR_4K}
                 ;
        }
        elsif ($max_chars <= (2**15-1)) {
            $sql = $type_conv->{$DT_STR_CHAR_32K};
        }
        elsif ($max_chars <= (2**16-1)) {
            $sql = $type_conv->{$DT_STR_CHAR_65K};
        }
        elsif ($max_chars <= (2**24-1)) {
            $sql = $type_conv->{$DT_STR_CHAR_16M};
        }
        elsif ($max_chars <= (2**31-1)) {
            $sql = $type_conv->{$DT_STR_CHAR_2G};
        }
        elsif ($max_chars <= (2**32-1)) {
            $sql = $type_conv->{$DT_STR_CHAR_4G};
        }
        else {
            $sql = $type_conv->{$DT_STR_CHAR_LG};
        }
        if ($max_chars < $INFINITY) {
            $sql = $builder->substitute_macros( $sql, { 'mc' => $max_chars } );
        }
        if ($char_enc) {
            $sql .= ' CHARACTER SET ' . $char_enc; # content of char_enc needs transforming
        }
    }

    if ($base_type eq 'BOOLEAN') {
        $sql = $type_conv->{$DT_BOOLEAN};
    }

    if ($base_type eq 'DATM_FULL') {
        $sql = $type_conv->{$DT_DATM_FULL};
    }
    if ($base_type eq 'DATM_DATE') {
        $sql = $type_conv->{$DT_DATM_DATE};
    }
    if ($base_type eq 'DATM_TIME') {
        $sql = $type_conv->{$DT_DATM_TIME};
    }

    if ($base_type eq 'INTRVL_YM') {
        $sql = $type_conv->{$DT_INTRVL_YM};
    }
    if ($base_type eq 'INTRVL_DT') {
        $sql = $type_conv->{$DT_INTRVL_DT};
    }

    if (@allowed_values) {
        if ($type_conv->{$DT_HAS_ENUM_TYPE}) {
            # ENUM type declaration replaces existing SQL type declaration.
            my @quoted = map { $builder->quote_literal( $_, 'STR_CHAR' ) } @allowed_values;
            $sql = 'ENUM(' . (join q{, }, @quoted) . ')'; # MySQL syntax
            # All literals are quoted as strings since MySQL treats integer values
            # as list indexes rather than list values.
        }
        else {
            # Append CHECK CONSTRAINT to existing SQL type declaration.
            my @quoted = map { $builder->quote_literal( $_, $base_type ) } @allowed_values;
            $sql .= ' CHECK VALUE IN (' . (join q{, }, @quoted) . ')'; # may be wrong syntax
        }
    }

    return $sql;
}

sub build_expr_row_data_type_defn {
    # SQL:2003, 6.1 "" (p161)
    # SQL:2003, 6.2 "" (p173)
    my ($builder, $row_data_type_node) = @_;
    $builder->_assert_arg_node_type( 'build_expr_row_data_type_defn',
        'ROW_DATA_TYPE_NODE', ['row_data_type'], $row_data_type_node );
    return 'ROW (' . (join q{, } . "\n",
        map { $builder->build_identifier_element( $_ ) . ' '
            . $builder->build_expr_scalar_data_type_defn( $_->get_attribute( 'scalar_data_type' ) ) }
        @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}) . ')';
    #  ::=  |  |  | ...
    #  ::= ROW
    #  ::=   [ (   ) ... ]
    #  ::=  |
    #  ::=  ARRAY [    ]
    #  ::=
}

sub build_expr_scalar_data_type_or_domain_name { # SQL:2003, 11.4 "" (p536)
    my ($builder, $scalar_dt_or_dom_node) = @_;
    $builder->_assert_arg_node_type( 'build_expr_scalar_data_type_or_domain_name',
        'SCALAR_DT_OR_DOM_NODE', ['scalar_data_type','scalar_domain'], $scalar_dt_or_dom_node );
    if ($scalar_dt_or_dom_node->get_node_type() eq 'scalar_data_type') {
        return $builder->build_expr_scalar_data_type_defn( $scalar_dt_or_dom_node ); #
    }
    elsif ($builder->{$PROP_INLINE_DOMAIN}) {
        return $builder->build_expr_scalar_data_type_defn(
            $scalar_dt_or_dom_node->get_attribute( 'data_type' ) ); #
    }
    else {
        return $builder->build_identifier_schema_or_app_obj( $scalar_dt_or_dom_node ); #
    }
}

sub build_expr_row_data_type_or_domain_name { # SQL:2003, 11.4 "" (p536)
    my ($builder, $row_dt_or_dom_node) = @_;
    $builder->_assert_arg_node_type( 'build_expr_row_data_type_or_domain_name',
        'ROW_DT_OR_DOM_NODE', ['row_data_type','row_domain'], $row_dt_or_dom_node );
    if ($row_dt_or_dom_node->get_node_type() eq 'row_data_type') {
        return $builder->build_expr_row_data_type_defn( $row_dt_or_dom_node ); #
    }
    elsif ($builder->{$PROP_INLINE_DOMAIN}) {
        return $builder->build_expr_row_data_type_defn(
            $row_dt_or_dom_node->get_attribute( 'data_type' ) ); #
    }
    else {
        return $builder->build_identifier_schema_or_app_obj( $row_dt_or_dom_node ); #
    }
}

######################################################################

# 6.2 "" (p173)
#  ::=

# 6.7 "" (p187)
#  ::=
#
#   | MODULE
# The MODULE... syntax is how you reference local temporary tables.

# 6.14 "" (p219)
#  ::=

# 6.23 ""
#
#
#

# 6.35 "" (p283)
# To concatenate:
#  is a
# Note:  is the same for arrays as strings.

# 6.36 "" (p285)
# By enumeration: ARRAY
# Note that an empty array has just the brackets; see 6.[one digit].
#  is comma-delimited list of
# By query: ARRAY   [  ]

######################################################################

sub build_expr_cast_spec { # SQL:2003, 6.12 "" (p201)
    my ($builder, $expr_node) = @_;
    $builder->_assert_arg_node_type( 'build_expr_cast_spec',
        'EXPR_NODE', ['view_expr','routine_expr'], $expr_node );
    # We are assuming that enumerated attribute 'expr_type' is 'CAST'.
    my %child_expr_nodes = map { (
            $_->get_attribute( 'call_sroutine_arg' ) => $_
        ) } @{$expr_node->get_child_nodes()};
    my $cast_target_node = $child_expr_nodes{'CAST_TARGET'};
    my $cast_operand = $builder->build_expr( $child_expr_nodes{'CAST_OPERAND'} );
    if (0) {
        # Expand this later to support non-standard operators like TO_STR, TO_NUM, TO_DATE, etc.
    }
    else {
        my $cast_target = $builder->build_expr_scalar_data_type_or_domain_name( $cast_target_node );
        return 'CAST (' . $cast_operand . ' AS ' . $cast_target . ')';
    }
}

######################################################################

sub build_expr_seq_next { # SQL:2003, 6.13 "" (p217)
    my ($builder, $sequence_node) = @_;
    $builder->_assert_arg_node_type( 'build_expr_seq_next',
        'SEQUENCE_NODE', ['sequence'], $sequence_node );
    my $sequence_name = $builder->build_identifier_schema_or_app_obj( $sequence_node );
    if ($builder->{$PROP_ORA_SEQ_USAGE}) {
        return $sequence_name . '.NEXTVAL';
    }
    else {
        return 'NEXT VALUE FOR ' . $sequence_name;
    }
}

######################################################################

sub build_expr_call_sroutine {
    # Corresponds to these sections:
    # 6.11 "" (p197)
    # 6.26 "" (p241)
    # 6.27 "" (p243)
    # 6.28 "" (p252)
    # 6.29 "" (p256)
    # 6.34 "" (p278)
    # 6.30 "" (p267)
    # 6.31 "" (p270)
    # 6.32 "" (p272)
    # 6.33 "" (p277)
    # 8.2 "" (p375)
    # 8.5 "" (p385)
    # 8.7 "" (p397)
    # 8.9 "" (p401)
    # 10.9 "" (p505)
    my ($builder, $expr_node) = @_;
    $builder->_assert_arg_node_type( 'build_expr_call_sroutine',
        'EXPR_NODE', ['view_expr','routine_expr'], $expr_node );
    my $sroutine = $expr_node->get_attribute( 'valf_call_sroutine' );
    my %child_exprs = map { (
            $_->get_attribute( 'call_sroutine_arg' ) => $_
        ) } @{$expr_node->get_child_nodes()};
    if ($sroutine eq 'CAST') {
        return $builder->build_expr_cast_spec( $expr_node );
    }
    elsif ($sroutine eq 'NOT') { #     - a logical 'not', true iif lone arg is false
        my $factor = $builder->build_expr( $child_exprs{'FACTOR'} );
        return '(NOT ' . $factor . ')';
    }
    elsif ($sroutine eq 'AND') { #     - a logical 'and', true iif every arg is true
        my $factors = $child_exprs{'FACTORS'}->get_child_nodes();
        return '(' . (join ' AND ', map { $builder->build_expr( $_ ) } @{$factors}) . ')';
    }
    elsif ($sroutine eq 'OR') { #      - a logical 'or', true iif at least one arg is true
        my $factors = $child_exprs{'FACTORS'}->get_child_nodes();
        return '(' . (join ' OR ', map { $builder->build_expr( $_ ) } @{$factors}) . ')';
    }
    elsif ($sroutine eq 'XOR') { #     - a logical 'xor', true iif 1+ arg true and 1+ arg false
        # Not implemented yet.
    }
    elsif ($sroutine eq 'EQ') { #      - true if both args are equal (both args cast same tp)
        my $lhs = $builder->build_expr( $child_exprs{'LHS'} );
        my $rhs = $builder->build_expr( $child_exprs{'RHS'} );
        return '(' . $lhs . ' = ' . $rhs . ')';
    }
    elsif ($sroutine eq 'NE') { #      - true if both args are unequal (when same data type)
        my $lhs = $builder->build_expr( $child_exprs{'LHS'} );
        my $rhs = $builder->build_expr( $child_exprs{'RHS'} );
        return '(' . $lhs . ' <> ' . $rhs . ')';
    }
    elsif ($sroutine eq 'LT') { #      - true if first arg is less than second
        my $lhs = $builder->build_expr( $child_exprs{'LHS'} );
        my $rhs = $builder->build_expr( $child_exprs{'RHS'} );
        return '(' . $lhs . ' < ' . $rhs . ')';
    }
    elsif ($sroutine eq 'GT') { #      - true if first arg is greater than second
        my $lhs = $builder->build_expr( $child_exprs{'LHS'} );
        my $rhs = $builder->build_expr( $child_exprs{'RHS'} );
        return '(' . $lhs . ' > ' . $rhs . ')';
    }
    elsif ($sroutine eq 'LE') { #      - true if first arg is less than or equal to second
        my $lhs = $builder->build_expr( $child_exprs{'LHS'} );
        my $rhs = $builder->build_expr( $child_exprs{'RHS'} );
        return '(' . $lhs . ' <= ' . $rhs . ')';
    }
    elsif ($sroutine eq 'GE') { #      - true if first arg is greater than or equal to second
        my $lhs = $builder->build_expr( $child_exprs{'LHS'} );
        my $rhs = $builder->build_expr( $child_exprs{'RHS'} );
        return '(' . $lhs . ' >= ' . $rhs . ')';
    }
    elsif ($sroutine eq 'IS_NULL') { # - true if only arg is not a null value
        my $arg = $builder->build_expr( $child_exprs{'ARG'} );
        return '(' . $arg . ' IS NULL)';
    }
    elsif ($sroutine eq 'NOT_NULL') { # - true if only arg is a null value
        my $arg = $builder->build_expr( $child_exprs{'ARG'} );
        return '(' . $arg . ' IS NOT NULL)';
    }
    elsif ($sroutine eq 'COALESCE') { # - returns first arg which is not null (like Oracle 'NVL')
        my $terms = $child_exprs{'TERMS'}->get_child_nodes();
        return 'COALESCE (' . (join q{, }, map { $builder->build_expr( $_ ) } @{$terms}) . ')';
        # Oracle calls this NVL(...).
    }
    elsif ($sroutine eq 'SWITCH') { #  - a logical switch-case expr (like Oracle 'decode')
        # Not implemented yet.  But the CASE/ELSE described at 6.11 (p197) would be used.
    }
    elsif ($sroutine eq 'LIKE') { #    - true if first arg contains second; args 3,4 are flags
        my $look_in = $builder->build_expr( $child_exprs{'LOOK_IN'} );
        my $look_for = $builder->build_expr( $child_exprs{'LOOK_FOR'} );
        my $prefix = $child_exprs{'FIXED_LEFT'} ? $EMPTY_STR : q{'%'||};
        my $postfix = $child_exprs{'FIXED_RIGHT'} ? $EMPTY_STR : q{||'%'};
        return '(' . $look_in . ' LIKE ' . $prefix . $look_for . $postfix . ')';
    }
    elsif ($sroutine eq 'ADD') { #     - sum result of adding all args as numbers
        my $terms = $child_exprs{'TERMS'}->get_child_nodes();
        return '(' . (join ' + ', map { $builder->build_expr( $_ ) } @{$terms}) . ')';
    }
    elsif ($sroutine eq 'SUB') { #     - difference result of subtracting second arg from first
        my $start = $builder->build_expr( $child_exprs{'START'} );
        my $remove = $builder->build_expr( $child_exprs{'REMOVE'} );
        return '(' . $start . ' - ' . $remove . ')';
    }
    elsif ($sroutine eq 'MUL') { #     - product result of multiplying all arguments
        my $factors = $child_exprs{'FACTORS'}->get_child_nodes();
        return '(' . (join ' * ', map { $builder->build_expr( $_ ) } @{$factors}) . ')';
    }
    elsif ($sroutine eq 'DIV') { #     - quotient result of dividing first argument by second
        my $dividend = $builder->build_expr( $child_exprs{'DIVIDEND'} );
        my $divisor = $builder->build_expr( $child_exprs{'DIVISOR'} );
        return '(' . $dividend . ' / ' . $divisor . ')';
    }
    elsif ($sroutine eq 'DIVI') { #    - integral division of first arg by second
        my $dividend = $builder->build_expr( $child_exprs{'DIVIDEND'} );
        my $divisor = $builder->build_expr( $child_exprs{'DIVISOR'} );
        # Not implemented yet.
    }
    elsif ($sroutine eq 'MOD') { #     - modulus of integral division of first arg by second
        my $dividend = $builder->build_expr( $child_exprs{'DIVIDEND'} );
        my $divisor = $builder->build_expr( $child_exprs{'DIVISOR'} );
        return 'MOD (' . $dividend . ', ' . $divisor . ')';
    }
    elsif ($sroutine eq 'ROUND') { #   - rounds first arg to N dec places; N is second arg or 0
        # Not implemented yet.
    }
    elsif ($sroutine eq 'ABS') { #     - absolute value of the operand (distance from zero)
        my $operand = $builder->build_expr( $child_exprs{'OPERAND'} );
        return 'ABS (' . $builder->build_expr( $operand ) . ')';
    }
    elsif ($sroutine eq 'POWER') { #   - raises first arg to the power of the second
        my $radix = $builder->build_expr( $child_exprs{'RADIX'} );
        my $exponent = $builder->build_expr( $child_exprs{'EXPONENT'} );
        return 'POWER (' . $radix . ', ' . $exponent . ')';
    }
    elsif ($sroutine eq 'LOG') { #     - logarithm of the first arg on the base of second
        # Note that SQL:2003 only defines LN(x), the natural logarithm, which is LOG-base-e-power-x;
        # we will implement LOG ourselves in terms of LN and DIV.
        my $start = $builder->build_expr( $child_exprs{'START'} );
        my $radix = $builder->build_expr( $child_exprs{'RADIX'} );
        return '(LN(' . $start . ') / LN(' . $radix . '))';
    }
    elsif ($sroutine eq 'SCONCAT') { # - L.cstr concat of all arguments
        my $factors = $child_exprs{'FACTORS'}->get_child_nodes();
        return '(' . (join ' || ', map { $builder->build_expr( $_ ) } @{$factors}) . ')';
    }
    elsif ($sroutine eq 'SLENGTH') { # - length of input string in characters
        my $source = $builder->build_expr( $child_exprs{'SOURCE'} );
        return 'CHAR_LENGTH (' . $source . ')';
        # OCTET_LENGTH for binary strings not implemented yet.
    }
    elsif ($sroutine eq 'SINDEX') { #  - pos in arg 1 of arg 2 if present, start at arg 3
        my $look_for = $builder->build_expr( $child_exprs{'LOOK_FOR'} );
        my $look_in = $builder->build_expr( $child_exprs{'LOOK_IN'} );
        my $start_pos = $builder->build_expr( $child_exprs{'START_POS'} );
        return 'POSITION (' . $look_for . ' IN ' . $look_in . ')'; # Arg 3 not implemented yet.
    }
    elsif ($sroutine eq 'SUBSTR') { #  - substr in arg 1 starting pos arg 2 of length arg 3
        my $look_in = $builder->build_expr( $child_exprs{'LOOK_IN'} );
        my $start_pos = $builder->build_expr( $child_exprs{'START_POS'} );
        my $str_len = $builder->build_expr( $child_exprs{'STR_LEN'} );
        return 'SUBSTRING (' . $look_in . ' FROM ' . $start_pos
               . ($str_len ? ' FOR ' . $str_len : $EMPTY_STR) . ')';
        # Version using SIMILAR to look for regular expressions not implemented yet.
    }
    elsif ($sroutine eq 'SREPEAT') { # - L.cstr concat arg 1 to self repeated by arg 2 instances
        my $factor = $builder->build_expr( $child_exprs{'FACTOR'} );
        my $repeat = $builder->build_expr( $child_exprs{'REPEAT'} );
        # Not implemented yet.
    }
    elsif ($sroutine eq 'STRIM') { #   - trims leading and trailing whitespace from arg 1
        my $source = $builder->build_expr( $child_exprs{'SOURCE'} );
        return 'TRIM (' . $source . ')';
        # SQL:2003, p259, says that "TRIM ()" is implicitly equivalent
        # to "TRIM (BOTH ' ' FROM )", which behaviour we want.
        # Other similar functions, such as just trimming left or right, or something other
        # than whitespace, isn't implemented yet.
    }
    elsif ($sroutine eq 'SPAD') { #    - lengthens arg 1 to length of arg 2 using arg 3 or space
        my $source = $builder->build_expr( $child_exprs{'SOURCE'} );
        # Not implemented yet.  Perhaps OVERLAY defined in SQL:2003, 6.29 is what does this.
    }
    elsif ($sroutine eq 'SPADL') { #   - like spad but add filler on left rather than right
        my $source = $builder->build_expr( $child_exprs{'SOURCE'} );
        # Not implemented yet.  Perhaps OVERLAY defined in SQL:2003, 6.29 is what does this.
    }
    elsif ($sroutine eq 'LC') { #      - lowercases latin chars in a string (SQL:2003 says this is a type of "folding")
        my $source = $builder->build_expr( $child_exprs{'SOURCE'} );
        return 'LOWER (' . $source . ')';
    }
    elsif ($sroutine eq 'UC') { #      - uppercases latin chars in a string (SQL:2003 says this is a type of "folding")
        my $source = $builder->build_expr( $child_exprs{'SOURCE'} );
        return 'UPPER (' . $source . ')';
    }
    elsif ($sroutine eq 'COUNT') { #  - aggregate - count of rows a view/cursor can see
        return 'COUNT(*)'; # specified in 10.9
    }
    elsif ($sroutine eq 'MIN') { #    - aggregate - minimum of values in all records in one view col
        my $factor = $builder->build_expr( $child_exprs{'FACTOR'} );
        return 'MIN (' . $factor . ')';
    }
    elsif ($sroutine eq 'MAX') { #    - aggregate - maximum of values in all records in one view col
        my $factor = $builder->build_expr( $child_exprs{'FACTOR'} );
        return 'MAX (' . $factor . ')';
    }
    elsif ($sroutine eq 'SUM') { #    - aggregate - sum of values in all records in one view col
        my $factor = $builder->build_expr( $child_exprs{'FACTOR'} );
        return 'SUM (' . $factor . ')';
    }
    elsif ($sroutine eq 'AVG') { #    - aggregate - average of values in all records in one view col
        my $factor = $builder->build_expr( $child_exprs{'FACTOR'} );
        return 'AVG (' . $factor . ')';
    }
    elsif ($sroutine eq 'CONCAT') { # - aggregate - L . cstr concat of values in all records in one view col
        my $factor = $builder->build_expr( $child_exprs{'FACTOR'} );
        # Not implemented yet.
    }
    elsif ($sroutine eq 'EVERY') { #  - aggregate - is true when all rec values in one col are true
        my $factor = $builder->build_expr( $child_exprs{'FACTOR'} );
        return 'EVERY (' . $factor . ')';
    }
    elsif ($sroutine eq 'ANY') { #    - aggregate - is true when at least one rec value in one col is true
        # 'SOME' is a synonym for 'ANY', according to MySQL
        my $factor = $builder->build_expr( $child_exprs{'FACTOR'} );
        return 'ANY (' . $factor . ')';
    }
    elsif ($sroutine eq 'EXISTS') { # - aggregate - is true when if there are > 0 rows
        my $factor = $builder->build_expr( $child_exprs{'FACTOR'} );
        return '(EXISTS ' . $factor . ')';
    }
    elsif ($sroutine eq 'GB_SETS') { # - olap, use in group-by - produces GROUPING SETS ( sub-exprs )
        my $factors = $child_exprs{'FACTORS'}->get_child_nodes();
        return 'GROUPING SETS (' . (join q{, }, map { $builder->build_expr( $_ ) } @{$factors}) . ')';
    }
    elsif ($sroutine eq 'GB_RLUP') { # - olap, use in group-by - produces ROLLUP ( sub-exprs )
        my $factors = $child_exprs{'FACTORS'}->get_child_nodes();
        return 'ROLLUP (' . (join q{, }, map { $builder->build_expr( $_ ) } @{$factors}) . ')';
    }
    elsif ($sroutine eq 'GB_CUBE') { # - olap, use in group-by - produces CUBE ( sub-exprs )
        my $factors = $child_exprs{'FACTORS'}->get_child_nodes();
        return 'CUBE (' . (join q{, }, map { $builder->build_expr( $_ ) } @{$factors}) . ')';
    }
    else {}
}

######################################################################

sub build_expr_call_uroutine {
    my ($builder, $expr_node) = @_;
    $builder->_assert_arg_node_type( 'build_expr_call_uroutine',
        'EXPR_NODE', ['view_expr','routine_expr'], $expr_node );
    my $uroutine = $expr_node->get_attribute( 'valf_call_uroutine' );
    my $uroutine_name = $builder->build_identifier_schema_or_app_obj( $uroutine );
    my %uroutine_arg_exprs
        = map { ($_->get_attribute( 'call_uroutine_arg' )->get_self_id() => $_) }
          @{$expr_node->get_child_nodes()}; # gets child [view/routine]_expr Nodes
    # Note: The build_expr() calls are done below to ensure the arg values are
    # defined in the same order they are output; this lets optional insertion
    # of positionally determined host params (and their mapping) to work right.
    my $arg_val_list = join q{, },
        map { $uroutine_arg_exprs{$_->get_self_id()}
            ? $builder->build_expr( $uroutine_arg_exprs{$_->get_self_id()} )
            : 'NULL' }
        @{$uroutine->get_child_nodes( 'routine_arg' )};
    return $uroutine_name
           . ($arg_val_list ? '(' . $arg_val_list . ')' : $EMPTY_STR);
}

######################################################################

sub build_query_table_expr { # SQL:2003, 7.4 "" (p300) 




1297




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1298




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_table_expr', 




1299




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1300




 





 





 





 





 





 



     return $builder->build_query_from_clause( $view_node ) 




1301




 





 





 





 





 





 



         . $builder->build_query_where_clause( $view_node ) 




1302




 





 





 





 





 





 



         . $builder->build_query_group_clause( $view_node ) 




1303




 





 





 





 





 





 



         . $builder->build_query_having_clause( $view_node ) 




1304




 





 





 





 





 





 



         . $builder->build_query_window_clause( $view_node ); 




1305




 





 





 





 





 





 



 } 




1306




 





 





 





 





 





 



   




1307




 





 





 





 





 





 



 ###################################################################### 




1308




 





 





 





 





 





 



   




1309




 





 





 





 





 





 



 sub build_query_from_clause { 




1310




 





 





 





 





 





 



     # SQL:2003, 7.5 "" (p301) 




1311




 





 





 





 





 





 



     # SQL:2003, 7.6 "" (p303) 




1312




 





 





 





 





 





 



     # SQL:2003, 7.7 "" (p312) 




1313




 





 





 





 





 





 



     # Method assumes that $view_node.view_type ne 'COMPOUND'; 




1314




 





 





 





 





 





 



     # method should never be invoked for those kinds of views. 




1315




 





 





 





 





 





 



     # Function returns empty string if view has no 'from' clause (a rarity). 




1316




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1317




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_from_clause', 




1318




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1319




 





 





 





 





 





 



     my $view_type = $view_node->get_attribute( 'view_type' ); 




1320




 





 





 





 





 





 



     my @view_src_nodes = @{$view_node->get_child_nodes( 'view_src' )}; 




1321




 





 





 





 





 





 



     my @view_join_nodes = @{$view_node->get_child_nodes( 'view_join' )}; 




1322




 





 





 





 





 





 



     if (@view_src_nodes == 0) { 




1323




 





 





 





 





 





 



         # There are no sources, and hence, no 'from' clause. 




1324




 





 





 





 





 





 



         return $EMPTY_STR; 




1325




 





 





 





 





 





 



     } 




1326




 





 





 





 





 





 



     elsif ($view_type eq 'ALIAS' or @view_src_nodes == 1) { 




1327




 





 





 





 





 





 



         # Trivial case: There is exactly one source, aka a single ""; 




1328




 





 





 





 





 





 



         # it can be either a table or named view or subquery. 




1329




 





 





 





 





 





 



         return "\n" . 'FROM ' . $builder->build_query_table_factor( $view_src_nodes[0] ); 




1330




 





 





 





 





 





 



     } 




1331




 





 





 





 





 





 



     else { 




1332




 





 





 





 





 





 



         # Complex case: There are 2 or more sources that are being joined. 




1333




 





 





 





 





 





 



         # The first step is to determine the join order, and only afterwards are 




1334




 





 





 





 





 





 



         # each  rendered into SQL; each  must be 




1335




 





 





 





 





 





 



         # generated in appearance order, so positional host param mapping works right. 




1336




 





 





 





 





 





 



         # Note: This code isn't very smart and assumes that all the view_join Nodes 




1337




 





 





 





 





 





 



         # are declared in the same order they should be output, even if their is 




1338




 





 





 





 





 





 



         # other evidence to the contrary.  This code can be smartened later. 




1339




 





 





 





 





 





 



         # This code also assumes that the ROS M is correct, such that all defined 




1340




 





 





 





 





 





 



         # view_src Nodes are involved in a single common view_join; there should be 




1341




 





 





 





 





 





 



         # exactly one fewer view_join Node than there are view_src Nodes. 




1342




 





 





 





 





 





 



         # TODO: Support the Oracle-8 way of putting join conditions in WHERE. 




1343




 





 





 





 





 





 



         my @sql_fragment_list = (); 




1344




 





 





 





 





 





 



         push @sql_fragment_list, $builder->build_query_table_factor( 




1345




 





 





 





 





 





 



             $view_join_nodes[0]->get_attribute( 'lhs_src' ) ); 




1346




 





 





 





 





 





 



         for my $view_join_node (@view_join_nodes) { 




1347




 





 





 





 





 





 



             my $join_op = $view_join_node->get_attribute( 'join_op' ); 




1348




 





 





 





 





 





 



             push @sql_fragment_list, "\n" 




1349




 





 





 





 





 





 



                  . ( $join_op eq 'CROSS' ? 'CROSS JOIN' 




1350




 





 





 





 





 





 



                    : $join_op eq 'INNER' ? 'INNER JOIN' 




1351




 





 





 





 





 





 



                    : $join_op eq 'LEFT'  ? 'LEFT OUTER JOIN' 




1352




 





 





 





 





 





 



                    : $join_op eq 'RIGHT' ? 'RIGHT OUTER JOIN' 




1353




 





 





 





 





 





 



                    : $join_op eq 'FULL'  ? 'FULL OUTER JOIN' 




1354




 





 





 





 





 





 



                    :                       undef # we should never get here 




1355




 





 





 





 





 





 



                    ); 




1356




 





 





 





 





 





 



             push @sql_fragment_list, $builder->build_query_table_factor( 




1357




 





 





 





 





 





 



                 $view_join_node->get_attribute( 'rhs_src' ) ); 




1358




 





 





 





 





 





 



             my @join_on_sql = (); 




1359




 





 





 





 





 





 



             for my $view_join_field_node (@{$view_join_node->get_child_nodes( 'view_join_field' )}) { 




1360




 





 





 





 





 





 



                 my $lhs_src_field_name = $builder->build_identifier_view_src_field( 




1361




 





 





 





 





 





 



                     $view_join_field_node->get_attribute( 'lhs_src_field' ) ); 




1362




 





 





 





 





 





 



                 my $rhs_src_field_name = $builder->build_identifier_view_src_field( 




1363




 





 





 





 





 





 



                     $view_join_field_node->get_attribute( 'rhs_src_field' ) ); 




1364




 





 





 





 





 





 



                 push @join_on_sql, $rhs_src_field_name . ' = ' . $lhs_src_field_name; 




1365




 





 





 





 





 





 



             } 




1366




 





 





 





 





 





 



             push @sql_fragment_list, 'ON ' . (join ' AND ', @join_on_sql); 




1367




 





 





 





 





 





 



         } 




1368




 





 





 





 





 





 



         return "\n" . 'FROM ' . (join ' ', @sql_fragment_list); 




1369




 





 





 





 





 





 



     } 




1370




 





 





 





 





 





 



 } 




1371




 





 





 





 





 





 



   




1372




 





 





 





 





 





 



 sub build_query_table_factor { # SQL:2003, 7.6 "" (p303) 




1373




 





 





 





 





 





 



     my ($builder, $view_src_node) = @_; 




1374




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_table_factor', 




1375




 





 





 





 





 





 



         'VIEW_SRC_NODE', ['view_src'], $view_src_node ); 




1376




 





 





 





 





 





 



     # Maybe TODO:  




1377




 





 





 





 





 





 



     my $correlation_name = $builder->build_identifier_element( $view_src_node ); 




1378




 





 





 





 





 





 



     my $match_node = $view_src_node->get_attribute( 'match' ); 




1379




 





 





 





 





 





 



     my $match_name = $builder->build_identifier_schema_or_app_obj( $match_node ); 




1380




 





 





 





 





 





 



     if ($match_node->get_node_type() eq 'view') { 




1381




 





 





 





 





 





 



         if ($match_node->get_primary_parent_attribute()->get_node_type() eq 'view') { 




1382




 





 





 





 





 





 



             # The view we are matching is a subquery. 




1383




 





 





 





 





 





 



             if ($builder->{$PROP_INLINE_SUBQ}) { 




1384




 





 





 





 





 





 



                 # Embed an anonymous subquery; argument passing is not yet supported. 




1385




 





 





 





 





 





 



                 my $query_expression = $builder->build_query_query_expr( $match_node ); 




1386




 





 





 





 





 





 



                 return '(' . $query_expression . ') AS ' . $correlation_name; 




1387




 





 





 





 





 





 



             } 




1388




 





 





 





 





 





 



             else { 




1389




 





 





 





 





 





 



                 # Call a named subquery; argument passing is supported. 




1390




 





 





 





 





 





 



                 my %src_args_to_view_exprs 




1391




 





 





 





 





 





 



                     = map { ($_->get_attribute( 'call_src_arg' )->get_self_id() => $_) } 




1392




 





 





 





 





 





 



                       grep { $_->get_attribute( 'view_part' ) eq 'FROM' } 




1393




 





 





 





 





 





 



                       @{$view_src_node->get_primary_parent_attribute()->get_child_nodes( 'view_expr' )}; 




1394




 





 





 





 





 





 



                 my %view_args_to_src_args 




1395




 





 





 





 





 





 



                     = map { ($_->get_attribute( 'match_view_arg' )->get_self_id() => $_) } 




1396




 





 





 





 





 





 



                       @{$view_src_node->get_child_nodes( 'view_src_arg' )}; 




1397




 





 





 





 





 





 



                 # Note: The build_expr() calls are done below to ensure the arg values are 




1398




 





 





 





 





 





 



                 # defined in the same order they are output; this lets optional insertion 




1399




 





 





 





 





 





 



                 # of positionally determined host params (and their mapping) to work right. 




1400




 





 





 





 





 





 



                 my $arg_list = join q{, }, 




1401




 





 





 





 





 





 



                     map { ($_ ? $builder->build_expr( $_ ) : 'NULL') } 




1402




 





 





 





 





 





 



                     map { $src_args_to_view_exprs{$view_args_to_src_args{$_->get_self_id()}->get_self_id()} } 




1403




 





 





 





 





 





 



                     @{$match_node->get_child_nodes( 'view_arg' )}; 




1404




 





 





 





 





 





 



                 return $match_name 




1405




 





 





 





 





 





 



                        . ($arg_list ? '(' . $arg_list . ')' : $EMPTY_STR) 




1406




 





 





 





 





 





 



                        . ' AS ' . $correlation_name; 




1407




 





 





 





 





 





 



             } 




1408




 





 





 





 





 





 



         } 




1409




 





 





 





 





 





 



         else { 




1410




 





 





 





 





 





 



             # The view we are matching is a schema object. 




1411




 





 





 





 





 





 



             return $match_name . ' AS ' . $correlation_name; 




1412




 





 





 





 





 





 



         } 




1413




 





 





 





 





 





 



     } 




1414




 





 





 





 





 





 



     else { # the source node is a base table schema object or a local variable of some kind 




1415




 





 





 





 





 





 



         return $match_name . ' AS ' . $correlation_name; 




1416




 





 





 





 





 





 



     } 




1417




 





 





 





 





 





 



 } 




1418




 





 





 





 





 





 



   




1419




 





 





 





 





 





 



 ###################################################################### 




1420




 





 





 





 





 





 



   




1421




 





 





 





 





 





 



 sub build_query_where_clause { # SQL:2003, 7.8 "" (p319) 




1422




 





 





 





 





 





 



     # Function returns empty string if view has no where clause. 




1423




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1424




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_where_clause', 




1425




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1426




 





 





 





 





 





 



     my @expr_list 




1427




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1428




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'WHERE' } 




1429




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1430




 





 





 





 





 





 



     return @expr_list ? "\n" . 'WHERE ' . $expr_list[0] : $EMPTY_STR; 




1431




 





 





 





 





 





 



 } 




1432




 





 





 





 





 





 



   




1433




 





 





 





 





 





 



 ###################################################################### 




1434




 





 





 





 





 





 



   




1435




 





 





 





 





 





 



 sub build_query_group_clause { # SQL:2003, 7.9 "" (p320) 




1436




 





 





 





 





 





 



     # Function returns empty string if view has no group by clause. 




1437




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1438




 





 





 





 





 





 



     my @expr_list 




1439




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1440




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'GROUP' } 




1441




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1442




 





 





 





 





 





 



     return @expr_list ? "\n" . 'GROUP BY ' . (join q{, }, @expr_list) : $EMPTY_STR; 




1443




 





 





 





 





 





 



     # Notes: Within build_expr(): 




1444




 





 





 





 





 





 



     #  implemented by COL basic_expr_type, 




1445




 





 





 





 





 





 



     #  and  implemented by LIST basic_expr_type, 




1446




 





 





 





 





 





 



     #  impl by ROSMN named GB_SETS, 




1447




 





 





 





 





 





 



     #  impl by ROSMN named GB_RLUP, 




1448




 





 





 





 





 





 



     #  impl by ROSMN named GB_CUBE. 




1449




 





 





 





 





 





 



     # Note:  has opt , looks redundant w SEL DIST|ALL; not impl. 




1450




 





 





 





 





 





 



 } 




1451




 





 





 





 





 





 



   




1452




 





 





 





 





 





 



 ###################################################################### 




1453




 





 





 





 





 





 



   




1454




 





 





 





 





 





 



 sub build_query_having_clause { # SQL:2003, 7.10 "" (p329) 




1455




 





 





 





 





 





 



     # Function returns empty string if view has no having clause. 




1456




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1457




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_having_clause', 




1458




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1459




 





 





 





 





 





 



     my @expr_list 




1460




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1461




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'HAVING' } 




1462




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1463




 





 





 





 





 





 



     return @expr_list ? "\n" . 'HAVING ' . $expr_list[0] : $EMPTY_STR; 




1464




 





 





 





 





 





 



 } 




1465




 





 





 





 





 





 



   




1466




 





 





 





 





 





 



 ###################################################################### 




1467




 





 





 





 





 





 



   




1468




 





 





 





 





 





 



 sub build_query_window_clause { # SQL:2003, 7.11 "" (p331) 




1469




 





 





 





 





 





 



     # Function returns empty string if view has no window clause. 




1470




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1471




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_window_clause', 




1472




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1473




 





 





 





 





 





 



     # TODO: I need to first update Rosetta::Model a bit re the various 




1474




 





 





 





 





 





 



     # parts of a , then fix here.  Meanwhile, I dump what I got. 




1475




 





 





 





 





 





 



     # Also see SQL:2003, 10.10 "" (p517) for future reference. 




1476




 





 





 





 





 





 



     my @order_list 




1477




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1478




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'ORDER' } 




1479




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1480




 





 





 





 





 





 



     my @maxr_list 




1481




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1482




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'MAXR' } 




1483




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1484




 





 





 





 





 





 



     my @skipr_list 




1485




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1486




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'SKIPR' } 




1487




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1488




 





 





 





 





 





 



     return (@order_list ? "\n" . 'ORDER BY ' . (join q{, }, @order_list) : $EMPTY_STR) 




1489




 





 





 





 





 





 



            . (@maxr_list ? "\n" . 'LIMIT ' . $maxr_list[0] : $EMPTY_STR) 




1490




 





 





 





 





 





 



            . (@skipr_list ? "\n" . 'OFFSET ' . $skipr_list[0] : $EMPTY_STR); 




1491




 





 





 





 





 





 



 } 




1492




 





 





 





 





 





 



   




1493




 





 





 





 





 





 



 ###################################################################### 




1494




 





 





 





 





 





 



   




1495




 





 





 





 





 





 



 sub build_query_query_spec { 




1496




 





 





 





 





 





 



     # SQL:2003, 7.12 "" (p341) 




1497




 





 





 





 





 





 



     # SQL:2003, 14.5 "" (p824) 




1498




 





 





 





 





 





 



     my ($builder, $view_node, $into_dest_node) = @_; 




1499




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_query_spec', 




1500




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1501




 





 





 





 





 





 



     defined $into_dest_node and $builder->_assert_arg_node_type( 'build_query_query_spec', 




1502




 





 





 





 





 





 



         'INTO_DEST_NODE', ['routine_arg','routine_var'], $into_dest_node ); 




1503




 





 





 





 





 





 



     # Method assumes that $view_node.view_type ne 'COMPOUND'; 




1504




 





 





 





 





 





 



     # method should never be invoked for those kinds of views. 




1505




 





 





 





 





 





 



     my $set_quantifier = $view_node->get_attribute( 'distinct_rows' ) ? 'DISTINCT' : 'ALL'; 




1506




 





 





 





 





 





 



     my $select_list = $builder->build_query_select_list( $view_node ); 




1507




 





 





 





 





 





 



     my $into_clause = $into_dest_node ? "\n" . 'INTO ' . $builder->build_identifier_element( $into_dest_node ) : $EMPTY_STR; 




1508




 





 





 





 





 





 



     my $table_expression = $builder->build_query_table_expr( $view_node ); 




1509




 





 





 





 





 





 



     return "\n" . 'SELECT ' . $set_quantifier . ' ' . $select_list . $into_clause . $table_expression; 




1510




 





 





 





 





 





 



 } 




1511




 





 





 





 





 





 



   




1512




 





 





 





 





 





 



 ###################################################################### 




1513




 





 





 





 





 





 



   




1514




 





 





 





 





 





 



 sub build_query_select_list { # SQL:2003, 7.12 "" (p341) 




1515




 





 





 





 





 





 



     # Method returns comma-delimited list expression where each list item is a 




1516




 





 





 





 





 





 



     # " ::=  AS ". 




1517




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1518




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_select_list', 




1519




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1520




 





 





 





 





 





 



     if ($view_node->get_attribute( 'view_type' ) eq 'ALIAS') { 




1521




 





 





 





 





 





 



         # Each result column must match a source column exactly. 




1522




 





 





 





 





 





 



         # Every source table/view result column or var field is output, with the same name. 




1523




 





 





 





 





 





 



         # It is assumed/required that the view has the same 'row_data_type' as the source. 




1524




 





 





 





 





 





 



         # While '*' would conceptually work here, we still explicitly enumerate col name list 




1525




 





 





 





 





 





 



         # so compound selects and select-intos don't break when original create tbl/vw statement 




1526




 





 





 





 





 





 



         # had declared columns in a different order than our row-data-type does. 




1527




 





 





 





 





 





 



         my $row_data_type_node = $builder->_row_data_type_of_node( $view_node ); 




1528




 





 





 





 





 





 



         return join q{, } . "\n", 




1529




 





 





 





 





 





 



             map { $builder->build_identifier_element( $_ ) } 




1530




 





 





 





 





 





 



             @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}; 




1531




 





 





 





 





 





 



     } 




1532




 





 





 





 





 





 



     else { # view_type ne 'ALIAS' 




1533




 





 





 





 





 





 



         # Each result column may come from an arbitrarily complex expression. 




1534




 





 





 





 





 





 



         # We have three statements below instead of one because we want the result cols shown 




1535




 





 





 





 





 





 



         # in order of the view's "row_data_type_field" Nodes, not the order of the 'view_part' if different. 




1536




 





 





 





 





 





 



         my %select_list_view_fields 




1537




 





 





 





 





 





 



             = map { ($_->get_attribute( 'si_row_field' )->get_self_id() => $_->get_attribute( 'src_field' )) } 




1538




 





 





 





 





 





 



               @{$view_node->get_child_nodes( 'view_field' )}; # note: 'src_field' may be undefined 




1539




 





 





 





 





 





 



         my %select_list_view_exprs 




1540




 





 





 





 





 





 



             = map { ($_->get_attribute( 'set_result_field' )->get_self_id() => $_) } 




1541




 





 





 





 





 





 



               grep { $_->get_attribute( 'view_part' ) eq 'RESULT' } 




1542




 





 





 





 





 





 



               @{$view_node->get_child_nodes( 'view_expr' )}; 




1543




 





 





 





 





 





 



         # Note: The build_expr() calls are done below to ensure the arg values are 




1544




 





 





 





 





 





 



         # defined in the same order they are output; this lets optional insertion 




1545




 





 





 





 





 





 



         # of positionally determined host params (and their mapping) to work right. 




1546




 





 





 





 





 





 



         my $row_data_type_node = $builder->_row_data_type_of_node( $view_node ); 




1547




 





 





 





 





 





 



         return join q{, } . "\n", 




1548




 





 





 





 





 





 



             map { ($select_list_view_fields{$_->get_self_id()} 




1549




 





 





 





 





 





 



                    ? $builder->build_identifier_view_src_field( $select_list_view_fields{$_->get_self_id()} ) 




1550




 





 





 





 





 





 



                    : $select_list_view_exprs{$_->get_self_id()} 




1551




 





 





 





 





 





 



                    ? $builder->build_expr( $select_list_view_exprs{$_->get_self_id()} ) 




1552




 





 





 





 





 





 



                    : 'NULL') 




1553




 





 





 





 





 





 



                 . ' AS ' . $builder->build_identifier_element( $_ ) } 




1554




 





 





 





 





 





 



             @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}; 




1555




 





 





 





 





 





 



         # Note that the default of NULL thing deals with view's row field that don't have any view_expr or src_field. 




1556




 





 





 





 





 





 



         # TODO IF NOT WRONG/OUTDATED: Note that the 'view_field' Nodes we actually need may be in a parent view 




1557




 





 





 





 





 





 



         # of the current view; right now we only are looking in the current view. 




1558




 





 





 





 





 





 



     } 




1559




 





 





 





 





 





 



 } 




1560




 





 





 





 





 





 



   




1561




 





 





 





 





 





 



 ###################################################################### 




1562




 





 





 





 





 





 



   




1563




 





 





 





 





 





 



 sub build_query_query_expr { # SQL:2003, 7.13 "" (p351) 




1564




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1565




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_query_expr', 




1566




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1567




 





 





 





 





 





 



     my $view_type = $view_node->get_attribute( 'view_type' ); 




1568




 





 





 





 





 





 



     my $with_clause = $EMPTY_STR; 




1569




 





 





 





 





 





 



     if (!$builder->{$PROP_INLINE_SUBQ}) { 




1570




 





 





 





 





 





 



         my @with_list = (); 




1571




 





 





 





 





 





 



         my $recursive = 0; 




1572




 





 





 





 





 





 



         for my $child_view_node (@{$view_node->get_child_nodes( 'view' )}) { 




1573




 





 





 





 





 





 



             if ($child_view_node->get_attribute( 'recursive' )) { 




1574




 





 





 





 





 





 



                 $recursive = 1; 




1575




 





 





 





 





 





 



             } 




1576




 





 





 





 





 





 



             my $with_item = $builder->build_identifier_element( $child_view_node ); 




1577




 





 





 





 





 





 



             if (my @child_arg_nodes = @{$child_view_node->get_child_nodes( 'view_arg' )}) { 




1578




 





 





 





 





 





 



                 $with_item .= '(' . (join q{, }, 




1579




 





 





 





 





 





 



                     map { $builder->build_identifier_element( $_ ) } 




1580




 





 





 





 





 





 



                     @child_arg_nodes) . ')'; 




1581




 





 





 





 





 





 



             } 




1582




 





 





 





 





 





 



             $with_item .= ' AS (' . $builder->build_query_query_expr( $child_view_node ) . ')'; 




1583




 





 





 





 





 





 



             push @with_list, $with_item; 




1584




 





 





 





 





 





 



         } 




1585




 





 





 





 





 





 



         if (@with_list) { 




1586




 





 





 





 





 





 



             $with_clause = "\n" . 'WITH ' . ($recursive ? 'RECURSIVE ' : $EMPTY_STR) . (join q{, }, @with_list); 




1587




 





 





 





 





 





 



         } 




1588




 





 





 





 





 





 



     } 




1589




 





 





 





 





 





 



     my $query_expression_body = $builder->build_query_query_expr_body( $view_node ); 




1590




 





 





 





 





 





 



     return $with_clause . $query_expression_body; 




1591




 





 





 





 





 





 



     # TODO: SQL:2003, 7.14 "" (p365). 




1592




 





 





 





 





 





 



 } 




1593




 





 





 





 





 





 



   




1594




 





 





 





 





 





 



 ###################################################################### 




1595




 





 





 





 





 





 



   




1596




 





 





 





 





 





 



 sub build_query_query_expr_body { # SQL:2003, 7.13 "" (p351) 




1597




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1598




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_query_expr_body', 




1599




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1600




 





 





 





 





 





 



     if ($view_node->get_attribute( 'view_type' ) eq 'COMPOUND') { 




1601




 





 





 





 





 





 



         # Result is multiple "SELECT ..." connected by one or more compound operators. 




1602




 





 





 





 





 





 



         my $compound_op = $view_node->get_attribute( 'compound_op' ); 




1603




 





 





 





 





 





 



         my $set_quantifier = $view_node->get_attribute( 'distinct_rows' ) ? 'DISTINCT' : 'ALL'; 




1604




 





 





 





 





 





 



         my @operand_list = (); 




1605




 





 





 





 





 





 



         for my $elem_node (@{$view_node->get_child_nodes( 'view_compound_elem' )}) { 




1606




 





 





 





 





 





 



             my $view_src_node = $elem_node->get_attribute( 'operand' ); 




1607




 





 





 





 





 





 



             my $match_node = $view_src_node->get_attribute( 'match' ); 




1608




 





 





 





 





 





 



             my $match_name = $builder->build_identifier_schema_or_app_obj( $match_node ); 




1609




 





 





 





 





 





 



             # Each compounding operand is assumed to have the same row data type as the view. 




1610




 





 





 





 





 





 



             if ($match_node->get_node_type() eq 'table') { 




1611




 





 





 





 





 





 



                 my $row_data_type_node = $builder->_row_data_type_of_node( $match_node ); 




1612




 





 





 





 





 





 



                 push @operand_list, join q{, } . "\n", 




1613




 





 





 





 





 





 



                     map { $builder->build_identifier_element( $_ ) } 




1614




 





 





 





 





 





 



                     @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}; 




1615




 





 





 





 





 





 



             } 




1616




 





 





 





 





 





 



             elsif ($match_node->get_node_type() eq 'view') { 




1617




 





 





 





 





 





 



                 push @operand_list, $builder->build_query_query_expr( $match_node ); 




1618




 





 





 





 





 





 



             } 




1619




 





 





 





 





 





 



             else { # the source node is a local variable of some kind 




1620




 





 





 





 





 





 



                 push @operand_list, $match_name; 




1621




 





 





 





 





 





 



             } 




1622




 





 





 





 





 





 



         } 




1623




 





 





 





 





 





 



         my $sql_operator 




1624




 





 





 





 





 





 



             = $compound_op eq 'UNION'        ? 'UNION' 




1625




 





 





 





 





 





 



             : $compound_op eq 'DIFFERENCE'   ? 'EXCEPT' 




1626




 





 





 





 





 





 



             : $compound_op eq 'INTERSECTION' ? 'INTERSECT' 




1627




 





 





 





 





 





 



             : $compound_op eq 'EXCLUSION'    ? 'EXCLUSION' # this 4th option not in SQL:2003. 




1628




 





 





 





 





 





 



             :                                  undef # we should never get here 




1629




 





 





 





 





 





 



             ; 




1630




 





 





 





 





 





 



             # TODO: try to emulate 'EXCLUSION' somewhere. 




1631




 





 





 





 





 





 



         return '(' . (join "\n" . $sql_operator . '_' . $set_quantifier, @operand_list) . ')'; 




1632




 





 





 





 





 





 



         # TODO: deal with engines that don't like "()" bounding compound operations. 




1633




 





 





 





 





 





 



         # TODO: possibly implement . 




1634




 





 





 





 





 





 



     } 




1635




 





 





 





 





 





 



     else { # view type ne 'COMPOUND' 




1636




 





 





 





 





 





 



         # Result is a single "SELECT ...", also known as a single "". 




1637




 





 





 





 





 





 



         return $builder->build_query_query_spec( $view_node ); 




1638




 





 





 





 





 





 



     } 




1639




 





 





 





 





 





 



 } 




1640




 





 





 





 





 





 



   




1641




 





 





 





 





 





 



 ###################################################################### 




1642




 





 





 





 





 





 



   




1643




 





 





 





 





 





 



 sub build_query_subquery { # SQL:2003, 7.15 "" (p370) 




1644




 





 





 





 





 





 



     my ($builder, $expr_node) = @_; 




1645




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_subquery', 




1646




 





 





 





 





 





 



         'EXPR_NODE', ['view_expr'], $expr_node ); 




1647




 





 





 





 





 





 



     my $cview = $expr_node->get_attribute( 'valf_call_view' ); 




1648




 





 





 





 





 





 



     if ($builder->{$PROP_INLINE_SUBQ}) { 




1649




 





 





 





 





 





 



         # Embed an anonymous subquery; argument passing is not yet supported. 




1650




 





 





 





 





 





 



         my $query_expression = $builder->build_query_query_expr( $cview ); 




1651




 





 





 





 





 





 



         return '(' . $query_expression . ')'; 




1652




 





 





 





 





 





 



     } 




1653




 





 





 





 





 





 



     else { 




1654




 





 





 





 





 





 



         # Call a named subquery; argument passing is supported. 




1655




 





 





 





 





 





 



         my $cview_name = $builder->build_identifier_schema_or_app_obj( $cview ); 




1656




 





 





 





 





 





 



         my %cview_arg_exprs 




1657




 





 





 





 





 





 



             = map { ($_->get_attribute( 'call_view_arg' )->get_self_id() => $_) } 




1658




 





 





 





 





 





 



               @{$expr_node->get_child_nodes()}; # gets child view_expr Nodes 




1659




 





 





 





 





 





 



         # Note: The build_expr() calls are done below to ensure the arg values are 




1660




 





 





 





 





 





 



         # defined in the same order they are output; this lets optional insertion 




1661




 





 





 





 





 





 



         # of positionally determined host params (and their mapping) to work right. 




1662




 





 





 





 





 





 



         my $arg_val_list = join q{, }, 




1663




 





 





 





 





 





 



             map { $cview_arg_exprs{$_->get_self_id()} 




1664




 





 





 





 





 





 



                   ? $builder->build_expr( $cview_arg_exprs{$_->get_self_id()} ) 




1665




 





 





 





 





 





 



                   : 'NULL' } 




1666




 





 





 





 





 





 



             @{$cview->get_child_nodes( 'view_arg' )}; 




1667




 





 





 





 





 





 



         return $cview_name . ($arg_val_list ? '(' . $arg_val_list . ')' : $EMPTY_STR); 




1668




 





 





 





 





 





 



     } 




1669




 





 





 





 





 





 



     # Note: Direct calls to schema object tables or views is not supported outside of 'FROM'. 




1670




 





 





 





 





 





 



 } 




1671




 





 





 





 





 





 



   




1672




 





 





 





 





 





 



 ###################################################################### 




1673




 





 





 





 





 





 



   




1674




 





 





 





 





 





 



 sub build_schema_create { # SQL:2003, 11.1 "" (p519) 




1675




 





 





 





 





 





 



     my ($builder, $schema_node) = @_; 




1676




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_create', 




1677




 





 





 





 





 





 



         'SCHEMA_NODE', ['schema'], $schema_node ); 




1678




 





 





 





 





 





 



     my $schema_name = $builder->build_identifier_element( $schema_node ); 




1679




 





 





 





 





 





 



     my $authorization = $EMPTY_STR; # TODO: AUTHORIZATION  




1680




 





 





 





 





 





 



     # Some other features in 11.1, such as default character set. 




1681




 





 





 





 





 





 



     return 'CREATE SCHEMA ' . $schema_name . ' ' . $authorization . ';' . "\n"; 




1682




 





 





 





 





 





 



 } 




1683




 





 





 





 





 





 



   




1684




 





 





 





 





 





 



 sub build_schema_delete { # SQL:2003, 11.2 "" (p522) 




1685




 





 





 





 





 





 



     my ($builder, $schema_node) = @_; 




1686




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_delete', 




1687




 





 





 





 





 





 



         'SCHEMA_NODE', ['schema'], $schema_node ); 




1688




 





 





 





 





 





 



     my $schema_name = $builder->build_identifier_element( $schema_node ); 




1689




 





 





 





 





 





 



     return 'DROP SCHEMA ' . $schema_name . ';' . "\n"; 




1690




 





 





 





 





 





 



 } 




1691




 





 





 





 





 





 



   




1692




 





 





 





 





 





 



 ###################################################################### 




1693




 





 





 





 





 





 



   




1694




 





 





 





 





 





 



 sub build_schema_or_app_scalar_domain_create { # SQL:2003, 11.24 "" (p603) 




1695




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1696




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_scalar_domain_create', 




1697




 





 





 





 





 





 



         'DOMAIN_NODE', ['scalar_domain'], $domain_node ); 




1698




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1699




 





 





 





 





 





 



     my $predefined_type = $builder->build_expr_scalar_data_type_defn( $domain_node ); 




1700




 





 





 





 





 





 



     # TODO: default clause, domain constraint, collate clause. 




1701




 





 





 





 





 





 



     my $is_temp = ($domain_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1702




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' DOMAIN ' . $domain_name . ' AS ' . $predefined_type . ';' . "\n"; 




1703




 





 





 





 





 





 



 } 




1704




 





 





 





 





 





 



   




1705




 





 





 





 





 





 



 sub build_schema_or_app_scalar_domain_delete { # SQL:2003, 11.30 "" (p610) 




1706




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1707




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_scalar_domain_delete', 




1708




 





 





 





 





 





 



         'DOMAIN_NODE', ['scalar_domain'], $domain_node ); 




1709




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1710




 





 





 





 





 





 



     return 'DROP DOMAIN ' . $domain_name . ';' . "\n"; 




1711




 





 





 





 





 





 



 } 




1712




 





 





 





 





 





 



   




1713




 





 





 





 





 





 



 ###################################################################### 




1714




 





 





 





 





 





 



   




1715




 





 





 





 





 





 



 sub build_schema_or_app_row_domain_create { # SQL:2003, 11.24 "" (p603) 




1716




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1717




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_row_domain_create', 




1718




 





 





 





 





 





 



         'DOMAIN_NODE', ['row_domain'], $domain_node ); 




1719




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1720




 





 





 





 





 





 



     my $predefined_type = $builder->build_expr_row_data_type_defn( $domain_node ); 




1721




 





 





 





 





 





 



     # TODO: default clause, domain constraint, collate clause. 




1722




 





 





 





 





 





 



     my $is_temp = ($domain_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1723




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' DOMAIN ' . $domain_name . ' AS ' . $predefined_type . ';' . "\n"; 




1724




 





 





 





 





 





 



 } 




1725




 





 





 





 





 





 



   




1726




 





 





 





 





 





 



 sub build_schema_or_app_row_domain_delete { # SQL:2003, 11.30 "" (p610) 




1727




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1728




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_row_domain_delete', 




1729




 





 





 





 





 





 



         'DOMAIN_NODE', ['row_domain'], $domain_node ); 




1730




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1731




 





 





 





 





 





 



     return 'DROP DOMAIN ' . $domain_name . ';' . "\n"; 




1732




 





 





 





 





 





 



 } 




1733




 





 





 





 





 





 



   




1734




 





 





 





 





 





 



 ###################################################################### 




1735




 





 





 





 





 





 



   




1736




 





 





 





 





 





 



 sub build_schema_or_app_sequence_create { # SQL:2003, 11.62 "" (p726) 




1737




 





 





 





 





 





 



     my ($builder, $sequence_node) = @_; 




1738




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_sequence_create', 




1739




 





 





 





 





 





 



         'SEQUENCE_NODE', ['sequence'], $sequence_node ); 




1740




 





 





 





 





 





 



     # SQL:2003 allows multiple data types for this, but we stick to integers for now. 




1741




 





 





 





 





 





 



     my $sequence_name = $builder->build_identifier_schema_or_app_obj( $sequence_node, 1 ); 




1742




 





 





 





 





 





 



     my $increment = $sequence_node->get_attribute( 'increment' ); 




1743




 





 





 





 





 





 



     my $min_val = $sequence_node->get_attribute( 'min_val' ); 




1744




 





 





 





 





 





 



     my $max_val = $sequence_node->get_attribute( 'max_val' ); 




1745




 





 





 





 





 





 



     my $start_val = $sequence_node->get_attribute( 'start_val' ); 




1746




 





 





 





 





 





 



     my $cycle = $sequence_node->get_attribute( 'cycle' ); 




1747




 





 





 





 





 





 



     my $order = $sequence_node->get_attribute( 'order' ); 




1748




 





 





 





 





 





 



     # Note that Rosetta::Model guarantees all integer attributes are already valid integers. 




1749




 





 





 





 





 





 



     my $is_temp = ($sequence_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1750




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' SEQUENCE ' . $sequence_name 




1751




 





 





 





 





 





 



         . (defined $increment ? ' INCREMENT BY ' . $increment : $EMPTY_STR) 




1752




 





 





 





 





 





 



         . (defined $start_val ? ' START WITH ' . $start_val : $EMPTY_STR) 




1753




 





 





 





 





 





 



         . (defined $min_val ? ' MINVALUE ' . $min_val : ' NO MINVALUE') 




1754




 





 





 





 





 





 



         . (defined $max_val ? ' MAXVALUE ' . $max_val : ' NO MAXVALUE') 




1755




 





 





 





 





 





 



         . ($cycle ? ' CYCLE' : ' NO CYCLE') 




1756




 





 





 





 





 





 



         . ($order ? ' ORDER' : ' NO ORDER') # standard doesn't mention this one 




1757




 





 





 





 





 





 



         . ';' . "\n"; 




1758




 





 





 





 





 





 



 } 




1759




 





 





 





 





 





 



   




1760




 





 





 





 





 





 



 sub build_schema_or_app_sequence_delete { # SQL:2003, 11.64 "" (p729) 




1761




 





 





 





 





 





 



     my ($builder, $sequence_node) = @_; 




1762




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_sequence_delete', 




1763




 





 





 





 





 





 



         'SEQUENCE_NODE', ['sequence'], $sequence_node ); 




1764




 





 





 





 





 





 



     my $sequence_name = $builder->build_identifier_schema_or_app_obj( $sequence_node, 1 ); 




1765




 





 





 





 





 





 



     return 'DROP SEQUENCE ' . $sequence_name . ';' . "\n"; 




1766




 





 





 





 





 





 



 } 




1767




 





 





 





 





 





 



   




1768




 





 





 





 





 





 



 ###################################################################### 




1769




 





 





 





 





 





 



   




1770




 





 





 





 





 





 



 sub build_schema_or_app_table_create { 




1771




 





 





 





 





 





 



     # SQL:2003, 6.2 "" (p173) 




1772




 





 





 





 





 





 



     # SQL:2003, 11.3 "" (p525) 




1773




 





 





 





 





 





 



     # SQL:2003, 11.4 "" (p536) 




1774




 





 





 





 





 





 



     # SQL:2003, 11.5 "" (p541) 




1775




 





 





 





 





 





 



     # SQL:2003, 11.6 "" (p545) 




1776




 





 





 





 





 





 



     # SQL:2003, 11.7 "" (p547) 




1777




 





 





 





 





 





 



     # SQL:2003, 11.8 "" (p549) 




1778




 





 





 





 





 





 



     # TODO: SQL:2003, 11.9 "" (p569) 




1779




 





 





 





 





 





 



     # TODO: "GENERATED ALWAYS AS ..." which looks like FileMaker's (etc) "calculation" field types. 




1780




 





 





 





 





 





 



     my ($builder, $table_node) = @_; 




1781




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_table_create', 




1782




 





 





 





 





 





 



         'TABLE_NODE', ['table'], $table_node ); 




1783




 





 





 





 





 





 



     my $table_name = $builder->build_identifier_schema_or_app_obj( $table_node, 1 ); 




1784




 





 





 





 





 





 



     my @table_field_sql = (); 




1785




 





 





 





 





 





 



     my %col_name_cache = (); # used when making ind defs 




1786




 





 





 





 





 





 



     my %mandatory_field_cache = (); # used when making ind defs 




1787




 





 





 





 





 





 



     my %table_fields_by_row_field = map { ($_->get_attribute( 'si_row_field' )->get_self_id() => $_) } 




1788




 





 





 





 





 





 



         @{$table_node->get_child_nodes( 'table_field' )}; 




1789




 





 





 





 





 





 



     my $row_data_type_node = $builder->_row_data_type_of_node( $table_node ); # is always set 




1790




 





 





 





 





 





 



     my $row_domain_node = $builder->_row_domain_of_node( $table_node ); # may be undefined 




1791




 





 





 





 





 





 



     for my $row_field_node (@{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}) { 




1792




 





 





 





 





 





 



         my $table_field_name = $builder->build_identifier_element( $row_field_node ); 




1793




 





 





 





 





 





 



         if (!exists $col_name_cache{$row_field_node->get_self_id()}) { 




1794




 





 





 





 





 





 



             $col_name_cache{$row_field_node->get_self_id()} = $table_field_name; 




1795




 





 





 





 





 





 



         } 




1796




 





 





 





 





 





 



         my $scalar_data_type_node = $row_field_node->get_attribute( 'scalar_data_type' ); 




1797




 





 





 





 





 





 



         my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( 




1798




 





 





 





 





 





 



             $row_domain_node ? $builder->find_scalar_domain_for_row_domain_field( 




1799




 





 





 





 





 





 



             $scalar_data_type_node, $row_domain_node ) : $scalar_data_type_node ); 




1800




 





 





 





 





 





 



         my $table_field_sql_item = $table_field_name . ' ' . $dt_or_dom_sql; 




1801




 





 





 





 





 





 



         if (my $table_field_node = $table_fields_by_row_field{$row_field_node->get_self_id()}) { 




1802




 





 





 





 





 





 



             my $mandatory = $table_field_node->get_attribute( 'mandatory' ); 




1803




 





 





 





 





 





 



             $mandatory and $mandatory_field_cache{$row_field_node->get_self_id()} = 1; 




1804




 





 





 





 





 





 



             my $default_val = $table_field_node->get_attribute( 'default_val' ); 




1805




 





 





 





 





 





 



             my $auto_inc = $table_field_node->get_attribute( 'auto_inc' ); 




1806




 





 





 





 





 





 



             my $default_seq_node = $table_field_node->get_attribute( 'default_seq' ); 




1807




 





 





 





 





 





 



             $table_field_sql_item .= ($mandatory ? ' NOT NULL' : ' NULL') 




1808




 





 





 





 





 





 



                 . (defined $default_val ? ' DEFAULT ' . $builder->quote_literal( 




1809




 





 





 





 





 





 



                     $default_val, $scalar_data_type_node->get_attribute( 'base_type' ) ) : $EMPTY_STR) 




1810




 





 





 





 





 





 



                 . ($auto_inc ? ' AUTO_INCREMENT' : $EMPTY_STR) 




1811




 





 





 





 





 





 



                 . ($default_seq_node ? ' DEFAULT ' 




1812




 





 





 





 





 





 



                     . $builder->build_expr_seq_next( $default_seq_node ) : $EMPTY_STR); 




1813




 





 





 





 





 





 



         } 




1814




 





 





 





 





 





 



         else { 




1815




 





 





 





 





 





 



             $table_field_sql_item .= ' NULL'; 




1816




 





 





 





 





 





 



         } 




1817




 





 





 





 





 





 



         push @table_field_sql, $table_field_sql_item; 




1818




 





 





 





 





 





 



     } 




1819




 





 





 





 





 





 



     my @table_index_sql = (); 




1820




 





 





 





 





 





 



     my $pk_is_made = 0; 




1821




 





 





 





 





 





 



     for my $table_index_node (@{$table_node->get_child_nodes( 'table_index' )}) { 




1822




 





 





 





 





 





 



         my $table_index_name = $builder->build_identifier_element( $table_index_node ); 




1823




 





 





 





 





 





 



         my $index_type = $table_index_node->get_attribute( 'index_type' ); 




1824




 





 





 





 





 





 



         my @table_index_field_nodes = @{$table_index_node->get_child_nodes( 'table_index_field' )}; 




1825




 





 





 





 





 





 



         my $local_field_names_sql = join q{, }, map { 




1826




 





 





 





 





 





 



                 $col_name_cache{$_->get_attribute( 'si_field' )->get_self_id()} 




1827




 





 





 





 





 





 



             } @table_index_field_nodes; 




1828




 





 





 





 





 





 



         if ($index_type eq 'ATOMIC') { 




1829




 





 





 





 





 





 



             push @table_index_sql, 'INDEX ' . $table_index_name . ' (' . $local_field_names_sql . ')'; 




1830




 





 





 





 





 





 



         } 




1831




 





 





 





 





 





 



         if ($index_type eq 'FULLTEXT') { 




1832




 





 





 





 





 





 



             push @table_index_sql, 'FULLTEXT INDEX ' . $table_index_name . ' (' . $local_field_names_sql . ')'; 




1833




 





 





 





 





 





 



         } 




1834




 





 





 





 





 





 



         if ($index_type eq 'UNIQUE' or $index_type eq 'UFOREIGN') { 




1835




 





 





 





 





 





 



             my $make_a_pk_now = 0; 




1836




 





 





 





 





 





 



             if (!$pk_is_made) { 




1837




 





 





 





 





 





 



                 # All component columns of a primary key must be mandatory; check for it. 




1838




 





 





 





 





 





 



                 $make_a_pk_now = all { 




1839




 





 





 





 





 





 



                         $mandatory_field_cache{ $_->get_attribute( 'si_field' )->get_self_id() } 




1840




 





 





 





 





 





 



                     } @table_index_field_nodes; 




1841




 





 





 





 





 





 



             } 




1842




 





 





 





 





 





 



             if ($make_a_pk_now) { 




1843




 





 





 





 





 





 



                 push @table_index_sql, 'CONSTRAINT PRIMARY KEY (' . $local_field_names_sql . ')'; 




1844




 





 





 





 





 





 



             } 




1845




 





 





 





 





 





 



             else { 




1846




 





 





 





 





 





 



                 push @table_index_sql, 'CONSTRAINT ' . $table_index_name . ' UNIQUE' 




1847




 





 





 





 





 





 



                     . ' (' . $local_field_names_sql . ')'; # standard does not say INDEX after UNIQUE 




1848




 





 





 





 





 





 



             } 




1849




 





 





 





 





 





 



         } 




1850




 





 





 





 





 





 



         if ($index_type eq 'FOREIGN' or $index_type eq 'UFOREIGN') { 




1851




 





 





 





 





 





 



             my $foreign_table_name = $builder->build_identifier_schema_or_app_obj( 




1852




 





 





 





 





 





 



                 $table_index_node->get_attribute( 'f_table' ) ); 




1853




 





 





 





 





 





 



             my $foreign_field_names_sql = join q{, }, map { 




1854




 





 





 





 





 





 



                     $builder->build_identifier_element( $_->get_attribute( 'f_field' ) ) 




1855




 





 





 





 





 





 



                 } @table_index_field_nodes; 




1856




 





 





 





 





 





 



             push @table_index_sql, 'CONSTRAINT ' . $table_index_name . ' FOREIGN KEY' 




1857




 





 





 





 





 





 



                 . ' (' . $local_field_names_sql . ') REFERENCES ' . $foreign_table_name 




1858




 





 





 





 





 





 



                 . ' (' . $foreign_field_names_sql . ')'; 




1859




 





 





 





 





 





 



         } 




1860




 





 





 





 





 





 



     } 




1861




 





 





 





 





 





 



     my $is_temp = ($table_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1862




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' TABLE ' . $table_name 




1863




 





 





 





 





 





 



            . ' (' . "\n" . (join q{, } . "\n", @table_field_sql, @table_index_sql) . "\n" . ');' . "\n"; 




1864




 





 





 





 





 





 



 } 




1865




 





 





 





 





 





 



   




1866




 





 





 





 





 





 



 sub build_schema_or_app_table_delete { # SQL:2003, 11.21 "" (p587) 




1867




 





 





 





 





 





 



     my ($builder, $table_node) = @_; 




1868




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_table_delete', 




1869




 





 





 





 





 





 



         'TABLE_NODE', ['table'], $table_node ); 




1870




 





 





 





 





 





 



     my $table_name = $builder->build_identifier_schema_or_app_obj( $table_node, 1 ); 




1871




 





 





 





 





 





 



     return 'DROP TABLE ' . $table_name . ';' . "\n"; 




1872




 





 





 





 





 





 



 } 




1873




 





 





 





 





 





 



   




1874




 





 





 





 





 





 



 ###################################################################### 




1875




 





 





 





 





 





 



   




1876




 





 





 





 





 





 



 sub build_schema_or_app_view_create { # SQL:2003, 11.22 "" (p590) 




1877




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1878




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_view_create', 




1879




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1880




 





 





 





 





 





 



     my $view_name = $builder->build_identifier_schema_or_app_obj( $view_node, 1 ); 




1881




 





 





 





 





 





 



     my $query_expression = $builder->build_query_query_expr( $view_node ); 




1882




 





 





 





 





 





 



     my $is_temp = ($view_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1883




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' VIEW ' . $view_name . ' AS ' . $query_expression . ';' . "\n"; 




1884




 





 





 





 





 





 



     # Note: Several interesting looking features are not implemented yet. 




1885




 





 





 





 





 





 



 } 




1886




 





 





 





 





 





 



   




1887




 





 





 





 





 





 



 sub build_schema_or_app_view_delete { # SQL:2003, 11.23 "" (p600) 




1888




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1889




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_view_delete', 




1890




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1891




 





 





 





 





 





 



     my $view_name = $builder->build_identifier_schema_or_app_obj( $view_node, 1 ); 




1892




 





 





 





 





 





 



     return 'DROP VIEW ' . $view_name . ';' . "\n"; 




1893




 





 





 





 





 





 



 } 




1894




 





 





 





 





 





 



   




1895




 





 





 





 





 





 



 ###################################################################### 




1896




 





 





 





 





 





 



   




1897




 





 





 





 





 





 



 sub build_schema_or_app_routine_create { 




1898




 





 





 





 





 





 



     # SQL:2003, 11.39 "" (p629) 




1899




 





 





 





 





 





 



     # SQL:2003, 11.50 "" (p675) 




1900




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




1901




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_routine_create', 




1902




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




1903




 





 





 





 





 





 



     my $routine_type = $routine_node->get_attribute( 'routine_type' ); 




1904




 





 





 





 





 





 



     my $routine_name = $builder->build_identifier_schema_or_app_obj( $routine_node, 1 ); 




1905




 





 





 





 





 





 



     my $is_temp = ($routine_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1906




 





 





 





 





 





 



     if ($routine_type eq 'PACKAGE') { 




1907




 





 





 





 





 





 



         # Not implemented yet. 




1908




 





 





 





 





 





 



     } 




1909




 





 





 





 





 





 



     elsif ($routine_type eq 'TRIGGER') { 




1910




 





 





 





 





 





 



         my $table_or_view_name = $builder->build_identifier_schema_or_app_obj( 




1911




 





 





 





 





 





 



             $routine_node->get_attribute( 'trigger_on' ) ); 




1912




 





 





 





 





 





 



         my $trigger_event = $routine_node->get_attribute( 'trigger_event' ); 




1913




 





 





 





 





 





 



         my $trigger_event_sql 




1914




 





 





 





 





 





 



             = $trigger_event eq 'BEFR_INS' ? 'BEFORE INSERT' 




1915




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_INS' ? 'AFTER INSERT' 




1916




 





 





 





 





 





 



             : $trigger_event eq 'INST_INS' ? 'INSTEAD OF INSERT' 




1917




 





 





 





 





 





 



             : $trigger_event eq 'BEFR_UPD' ? 'BEFORE UPDATE' 




1918




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_UPD' ? 'AFTER UPDATE' 




1919




 





 





 





 





 





 



             : $trigger_event eq 'INST_UPD' ? 'INSTEAD OF UPDATE' 




1920




 





 





 





 





 





 



             : $trigger_event eq 'BEFR_DEL' ? 'BEFORE DELETE' 




1921




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_DEL' ? 'AFTER DELETE' 




1922




 





 





 





 





 





 



             : $trigger_event eq 'INST_DEL' ? 'INSTEAD OF DELETE' 




1923




 





 





 





 





 





 



             :                                undef # we should never get here 




1924




 





 





 





 





 





 



             ; 




1925




 





 





 





 





 





 



             # Note: INSTEAD OF is not standard SQL, but supported by SQLServer 2000, maybe Oracle, ?. 




1926




 





 





 





 





 





 



         my $for_each_stmt = $routine_node->get_attribute( 'trigger_per_stmt' ); 




1927




 





 





 





 





 





 



         # TODO: Implement optional OF . 




1928




 





 





 





 





 





 



         my @transition_var_names = (); # TODO: NEW/OLD ROW AS <... variable name> 




1929




 





 





 





 





 





 



         my $triggered_sql_statement = $builder->build_dmanip_routine_body( $routine_node, 1 ); 




1930




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' TRIGGER ' . $routine_name . ' ' 




1931




 





 





 





 





 





 



             . $trigger_event_sql . ' ON ' . $table_or_view_name 




1932




 





 





 





 





 





 



             . (@transition_var_names ? ' REFERENCING ' . (join ' ', @transition_var_names) : $EMPTY_STR) 




1933




 





 





 





 





 





 



             . ($for_each_stmt ? ' FOR EACH STATEMENT' : ' FOR EACH ROW') 




1934




 





 





 





 





 





 



             # TODO: WHEN (  ) 




1935




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1936




 





 





 





 





 





 



             . $triggered_sql_statement 




1937




 





 





 





 





 





 



             . ';' . "\n"; 




1938




 





 





 





 





 





 



     } 




1939




 





 





 





 





 





 



     elsif ($routine_type eq 'PROCEDURE') { 




1940




 





 





 





 





 





 



         my $routine_args = $builder->build_dmanip_routine_args( $routine_node ); 




1941




 





 





 





 





 





 



         # TODO:  where appropriate. 




1942




 





 





 





 





 





 



         my $routine_body = $builder->build_dmanip_routine_body( $routine_node ); 




1943




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' PROCEDURE ' . $routine_name 




1944




 





 





 





 





 





 



             . $routine_args 




1945




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1946




 





 





 





 





 





 



             . ' ' . $routine_body . ';' . "\n"; 




1947




 





 





 





 





 





 



     } 




1948




 





 





 





 





 





 



     elsif ($routine_type eq 'FUNCTION') { 




1949




 





 





 





 





 





 



         my $routine_args = $builder->build_dmanip_routine_args( $routine_node ); 




1950




 





 





 





 





 





 



         # TODO:  where appropriate. 




1951




 





 





 





 





 





 



         my $routine_body = $builder->build_dmanip_routine_body( $routine_node ); 




1952




 





 





 





 





 





 



         my $return_cont_type = $routine_node->get_attribute( 'return_cont_type' ); 




1953




 





 





 





 





 





 



         my $return_data_type = $EMPTY_STR; 




1954




 





 





 





 





 





 



         if ($return_cont_type eq 'ERROR') { 




1955




 





 





 





 





 





 



             # Not implemented yet. 




1956




 





 





 





 





 





 



         } 




1957




 





 





 





 





 





 



         elsif ($return_cont_type eq 'SCALAR') { 




1958




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_scalar_data_type' ); 




1959




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




1960




 





 





 





 





 





 



         } 




1961




 





 





 





 





 





 



         elsif ($return_cont_type eq 'ROW') { 




1962




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_row_data_type' ); 




1963




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




1964




 





 





 





 





 





 



         } 




1965




 





 





 





 





 





 



         elsif ($return_cont_type eq 'SC_ARY') { 




1966




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_scalar_data_type' ); 




1967




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ) . ' ARRAY'; 




1968




 





 





 





 





 





 



         } 




1969




 





 





 





 





 





 



         elsif ($return_cont_type eq 'RW_ARY') { 




1970




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_row_data_type' ); 




1971




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ) . ' ARRAY'; 




1972




 





 





 





 





 





 



         } 




1973




 





 





 





 





 





 



         elsif ($return_cont_type eq 'CONN') { 




1974




 





 





 





 





 





 



             # Not implemented yet. 




1975




 





 





 





 





 





 



         } 




1976




 





 





 





 





 





 



         elsif ($return_cont_type eq 'CURSOR') { 




1977




 





 





 





 





 





 



             # Not implemented yet. 




1978




 





 





 





 





 





 



         } 




1979




 





 





 





 





 





 



         elsif ($return_cont_type eq 'LIST') { 




1980




 





 





 





 





 





 



             # Not implemented yet. 




1981




 





 





 





 





 





 



         } 




1982




 





 





 





 





 





 



         else {} 




1983




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' FUNCTION ' . $routine_name 




1984




 





 





 





 





 





 



             . $routine_args 




1985




 





 





 





 





 





 



             . ' RETURNS ' . $return_data_type 




1986




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1987




 





 





 





 





 





 



             . ' ' . $routine_body . ';' . "\n"; 




1988




 





 





 





 





 





 



     } 




1989




 





 





 





 





 





 



     else {} # $routine_type eq 'BLOCK' 




1990




 





 





 





 





 





 



         # 'BLOCK': no-op; you should call build_dmanip_routine_body() directly instead 




1991




 





 





 





 





 





 



 } 




1992




 





 





 





 





 





 



   




1993




 





 





 





 





 





 



 sub build_schema_or_app_routine_delete { 




1994




 





 





 





 





 





 



     # SQL:2003, 11.40 "" (p633) 




1995




 





 





 





 





 





 



     # SQL:2003, 11.52 "" (p703) 




1996




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




1997




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_routine_delete', 




1998




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




1999




 





 





 





 





 





 



     my $routine_type = $routine_node->get_attribute( 'routine_type' ); 




2000




 





 





 





 





 





 



     my $routine_name = $builder->build_identifier_schema_or_app_obj( $routine_node, 1 ); 




2001




 





 





 





 





 





 



     # Note: 10.6 "" (p499) may be useful later. 




2002




 





 





 





 





 





 



     if ($routine_type eq 'PACKAGE') { 




2003




 





 





 





 





 





 



         # Not implemented yet. 




2004




 





 





 





 





 





 



     } 




2005




 





 





 





 





 





 



     elsif ($routine_type eq 'TRIGGER') { 




2006




 





 





 





 





 





 



         return 'DROP TRIGGER ' . $routine_name . ';' . "\n"; 




2007




 





 





 





 





 





 



     } 




2008




 





 





 





 





 





 



     elsif ($routine_type eq 'PROCEDURE') { 




2009




 





 





 





 





 





 



         return 'DROP PROCEDURE ' . $routine_name . ';' . "\n"; 




2010




 





 





 





 





 





 



     } 




2011




 





 





 





 





 





 



     elsif ($routine_type eq 'FUNCTION') { 




2012




 





 





 





 





 





 



         return 'DROP FUNCTION ' . $routine_name . ';' . "\n"; 




2013




 





 





 





 





 





 



     } 




2014




 





 





 





 





 





 



     else {} # $routine_type eq 'BLOCK'; no-op 




2015




 





 





 





 





 





 



 } 




2016




 





 





 





 





 





 



   




2017




 





 





 





 





 





 



 ###################################################################### 




2018




 





 





 





 





 





 



   




2019




 





 





 





 





 





 



 sub build_access_role_create { # SQL:2003, 12.4 "" (p743) 




2020




 





 





 





 





 





 



     my ($builder, $role_node) = @_; 




2021




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_role_create', 




2022




 





 





 





 





 





 



         'ROLE_NODE', ['role'], $role_node ); 




2023




 





 





 





 





 





 



     my $role_name = $builder->build_identifier_element( $role_node ); 




2024




 





 





 





 





 





 



     return 'CREATE ROLE ' . $role_name . ';' . "\n"; 




2025




 





 





 





 





 





 



 } 




2026




 





 





 





 





 





 



   




2027




 





 





 





 





 





 



 sub build_access_role_delete { # SQL:2003, 12.6 "" (p746) 




2028




 





 





 





 





 





 



     my ($builder, $role_node) = @_; 




2029




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_role_delete', 




2030




 





 





 





 





 





 



         'ROLE_NODE', ['role'], $role_node ); 




2031




 





 





 





 





 





 



     my $role_name = $builder->build_identifier_element( $role_node ); 




2032




 





 





 





 





 





 



     return 'DROP ROLE ' . $role_name . ';' . "\n"; 




2033




 





 





 





 





 





 



 } 




2034




 





 





 





 





 





 



   




2035




 





 





 





 





 





 



 ###################################################################### 




2036




 





 





 





 





 





 



   




2037




 





 





 





 





 





 



 sub build_access_grant { 




2038




 





 





 





 





 





 



     # Function returns empty string if given grantee has no privileges. 




2039




 





 





 





 





 





 



     # SQL:2003, 12.1 "" (p731) 




2040




 





 





 





 





 





 



     # SQL:2003, 12.2 "" (p736) 




2041




 





 





 





 





 





 



     # SQL:2003, 12.3 "" (p739) 




2042




 





 





 





 





 





 



     # SQL:2003, 12.5 "" (p744) 




2043




 





 





 





 





 





 



     my ($builder, $grantee_node) = @_; 




2044




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_grant', 




2045




 





 





 





 





 





 



         'GRANTEE_NODE', ['role','user'], $grantee_node ); 




2046




 





 





 





 





 





 



     my $node_type = $grantee_node->get_node_type(); 




2047




 





 





 





 





 





 



     my $grantee_name = $builder->build_identifier_schema_or_app_obj( $grantee_node ); 




2048




 





 





 





 





 





 



     if ($node_type eq 'role') { 




2049




 





 





 





 





 





 



         my @grant_stmts = (); 




2050




 





 





 





 





 





 



         for my $priv_on_node (@{$grantee_node->get_child_nodes( 'privilege_on' )}) { 




2051




 





 





 





 





 





 



             my $object_node = $priv_on_node->get_attribute( 'si_priv_on' ); 




2052




 





 





 





 





 





 



             my $object_name = $builder->build_identifier_schema_or_app_obj( $object_node ); 




2053




 





 





 





 





 





 



             my @priv_types = map { $_->get_attribute( 'si_priv_type' ) } 




2054




 





 





 





 





 





 



                 @{$priv_on_node->get_child_nodes( 'privilege_for' )}; 




2055




 





 





 





 





 





 



             my @object_privs = (); 




2056




 





 





 





 





 





 



             if (grep { $_ eq 'ALL' } @priv_types) { 




2057




 





 





 





 





 





 



                 push @object_privs, 'ALL PRIVILEGES'; 




2058




 





 





 





 





 





 



             } 




2059




 





 





 





 





 





 



             else { 




2060




 





 





 





 





 





 



                 for my $priv_type (@priv_types) { 




2061




 





 





 





 





 





 



                     push @object_privs, 




2062




 





 





 





 





 





 



                            $priv_type eq 'SELECT' ? 'SELECT' # TODO: allow only specific columns 




2063




 





 





 





 





 





 



                          : $priv_type eq 'DELETE' ? 'DELETE' 




2064




 





 





 





 





 





 



                          : $priv_type eq 'INSERT' ? 'INSERT' # TODO: allow only specific columns 




2065




 





 





 





 





 





 



                          : $priv_type eq 'UPDATE' ? 'UPDATE' # TODO: allow only specific columns 




2066




 





 





 





 





 





 



                          :                          $EMPTY_STR # TODO: REFERENCES, USAGE, TRIGGER, UNDER, EXECUTE; what do they mean? 




2067




 





 





 





 





 





 



                          ; 




2068




 





 





 





 





 





 



                 } 




2069




 





 





 





 





 





 



             } 




2070




 





 





 





 





 





 



             push @grant_stmts, 'GRANT ' . (join q{, }, @object_privs) 




2071




 





 





 





 





 





 



                 . ' ON ' . $object_name . ' TO ' . $grantee_name . ';'; 




2072




 





 





 





 





 





 



         } 




2073




 





 





 





 





 





 



         return join $EMPTY_STR, @grant_stmts; 




2074




 





 





 





 





 





 



     } 




2075




 





 





 





 





 





 



     elsif ($node_type eq 'user') { 




2076




 





 





 





 





 





 



         my @role_names = map { $builder->build_identifier_schema_or_app_obj( $_ ) } 




2077




 





 





 





 





 





 



             @{$grantee_node->get_child_nodes( 'user_role' )}; 




2078




 





 





 





 





 





 



         return @role_names ? 'GRANT ' . (join q{, }, @role_names) . ' TO ' . $grantee_name . ';' : $EMPTY_STR; 




2079




 





 





 





 





 





 



     } 




2080




 





 





 





 





 





 



     else {} 




2081




 





 





 





 





 





 



 } 




2082




 





 





 





 





 





 



   




2083




 





 





 





 





 





 



 sub build_access_revoke { 




2084




 





 





 





 





 





 



     # SQL:2003, 12.7 "" (p747) 




2085




 





 





 





 





 





 



     # SQL:2003, 12.3 "" (p739) 




2086




 





 





 





 





 





 



     my ($builder, $grantee_node) = @_; 




2087




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_revoke', 




2088




 





 





 





 





 





 



         'GRANTEE_NODE', ['role','user'], $grantee_node ); 




2089




 





 





 





 





 





 



     my $node_type = $grantee_node->get_node_type(); 




2090




 





 





 





 





 





 



     my $grantee_name = $builder->build_identifier_schema_or_app_obj( $grantee_node ); 




2091




 





 





 





 





 





 



     if ($node_type eq 'role') { 




2092




 





 





 





 





 





 



         my @revoke_stmts = (); 




2093




 





 





 





 





 





 



         for my $priv_on_node (@{$grantee_node->get_child_nodes( 'privilege_on' )}) { 




2094




 





 





 





 





 





 



             my $object_node = $priv_on_node->get_attribute( 'si_priv_on' ); 




2095




 





 





 





 





 





 



             my $object_name = $builder->build_identifier_schema_or_app_obj( $object_node ); 




2096




 





 





 





 





 





 



             push @revoke_stmts, 'REVOKE ALL PRIVILEGES' 




2097




 





 





 





 





 





 



                 . ' ON ' . $object_name . ' FROM ' . $grantee_name . ';'; 




2098




 





 





 





 





 





 



         } 




2099




 





 





 





 





 





 



         return join $EMPTY_STR, @revoke_stmts; 




2100




 





 





 





 





 





 



     } 




2101




 





 





 





 





 





 



     elsif ($node_type eq 'user') { 




2102




 





 





 





 





 





 



         my @role_names = map { $builder->build_identifier_schema_or_app_obj( $_ ) } 




2103




 





 





 





 





 





 



             @{$grantee_node->get_child_nodes( 'user_role' )}; 




2104




 





 





 





 





 





 



         return @role_names ? 'REVOKE ' . (join q{, }, @role_names) . ' FROM ' . $grantee_name . ';' : $EMPTY_STR; 




2105




 





 





 





 





 





 



     } 




2106




 





 





 





 





 





 



     else {} 




2107




 





 





 





 





 





 



 } 




2108




 





 





 





 





 





 



   




2109




 





 





 





 





 





 



 ###################################################################### 




2110




 





 





 





 





 





 



   




2111




 





 





 





 





 





 



 sub build_dmanip_routine_args { 




2112




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




2113




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_args', 




2114




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




2115




 





 





 





 





 





 



     # SQL:2003, 11.50 "" (p675) 




2116




 





 





 





 





 





 



     # in particular see  




2117




 





 





 





 





 





 



     my @rtn_arg_declare_sql = (); 




2118




 





 





 





 





 





 



     for my $rtn_arg_node (@{$routine_node->get_child_nodes( 'routine_arg' )}) { 




2119




 





 





 





 





 





 



         # TODO:  ::= IN | OUT | INOUT 




2120




 





 





 





 





 





 



         my $arg_name = $builder->build_identifier_element( $rtn_arg_node ); 




2121




 





 





 





 





 





 



         my $cont_type = $rtn_arg_node->get_attribute( 'cont_type' ); 




2122




 





 





 





 





 





 



         if ($cont_type eq 'ERROR') { 




2123




 





 





 





 





 





 



             # Not implemented yet. 




2124




 





 





 





 





 





 



         } 




2125




 





 





 





 





 





 



         elsif ($cont_type eq 'SCALAR') { 




2126




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'scalar_data_type' ); 




2127




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2128




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ';'; 




2129




 





 





 





 





 





 



         } 




2130




 





 





 





 





 





 



         elsif ($cont_type eq 'ROW') { 




2131




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'row_data_type' ); 




2132




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2133




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ';'; 




2134




 





 





 





 





 





 



         } 




2135




 





 





 





 





 





 



         elsif ($cont_type eq 'SC_ARY') { 




2136




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'scalar_data_type' ); 




2137




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2138




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2139




 





 





 





 





 





 



         } 




2140




 





 





 





 





 





 



         elsif ($cont_type eq 'RW_ARY') { 




2141




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'row_data_type' ); 




2142




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2143




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2144




 





 





 





 





 





 



         } 




2145




 





 





 





 





 





 



         elsif ($cont_type eq 'CONN') { 




2146




 





 





 





 





 





 



             # Not implemented yet. 




2147




 





 





 





 





 





 



         } 




2148




 





 





 





 





 





 



         elsif ($cont_type eq 'CURSOR') { 




2149




 





 





 





 





 





 



             # Not implemented yet. 




2150




 





 





 





 





 





 



         } 




2151




 





 





 





 





 





 



         elsif ($cont_type eq 'LIST') { 




2152




 





 





 





 





 





 



             # Not implemented yet. 




2153




 





 





 





 





 





 



         } 




2154




 





 





 





 





 





 



         else {} 




2155




 





 





 





 





 





 



     } 




2156




 





 





 





 





 





 



     return @rtn_arg_declare_sql ? '(' . (join q{, }, @rtn_arg_declare_sql) . ')' : $EMPTY_STR; 




2157




 





 





 





 





 





 



 } 




2158




 





 





 





 





 





 



   




2159




 





 





 





 





 





 



 sub build_dmanip_routine_body { 




2160




 





 





 





 





 





 



     # Corresponds to these sections: 




2161




 





 





 





 





 





 



     # ? 




2162




 





 





 





 





 





 



     # SQL:2003, 6.1 "" (p161) 




2163




 





 





 





 





 





 



     # SQL:2003, 13.5 "" (p790) 




2164




 





 





 





 





 





 



     # SQL:2003, 14.1 "" (p809) 




2165




 





 





 





 





 





 



     my ($builder, $routine_node, $is_atomic) = @_; 




2166




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_body', 




2167




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




2168




 





 





 





 





 





 



     my $is_ora_routines = $builder->{$PROP_ORA_ROUTINES}; 




2169




 





 





 





 





 





 



     my @rtn_var_declare_sql = (); 




2170




 





 





 





 





 





 



     for my $rtn_var_node (@{$routine_node->get_child_nodes( 'routine_var' )}) { 




2171




 





 





 





 





 





 



         my $var_name = $builder->build_identifier_element( $rtn_var_node ); 




2172




 





 





 





 





 





 



         my $cont_type = $rtn_var_node->get_attribute( 'cont_type' ); 




2173




 





 





 





 





 





 



         if ($cont_type eq 'ERROR') { 




2174




 





 





 





 





 





 



             # Not implemented yet. 




2175




 





 





 





 





 





 



         } 




2176




 





 





 





 





 





 



         elsif ($cont_type eq 'SCALAR') { 




2177




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'scalar_data_type' ); 




2178




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2179




 





 





 





 





 





 



             my $init_lit_val = $rtn_var_node->get_attribute( 'init_lit_val' ); 




2180




 





 





 





 





 





 



             my $is_constant = $rtn_var_node->get_attribute( 'is_constant' ); 




2181




 





 





 





 





 





 



             push @rtn_var_declare_sql, 




2182




 





 





 





 





 





 



                 ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') 




2183




 





 





 





 





 





 



                 . $var_name . ' ' . $dt_or_dom_sql 




2184




 





 





 





 





 





 



                 # TODO: use $is_constant 




2185




 





 





 





 





 





 



                 . (defined $init_lit_val ? ' DEFAULT ' . $builder->quote_literal( $init_lit_val, 




2186




 





 





 





 





 





 



                     $builder->_scalar_data_type_of_node( $rtn_var_node )->get_attribute( 'base_type' ) ) : $EMPTY_STR) 




2187




 





 





 





 





 





 



                 . ';' 




2188




 





 





 





 





 





 



             ; 




2189




 





 





 





 





 





 



         } 




2190




 





 





 





 





 





 



         elsif ($cont_type eq 'ROW') { 




2191




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'row_data_type' ); 




2192




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2193




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ';'; 




2194




 





 





 





 





 





 



         } 




2195




 





 





 





 





 





 



         elsif ($cont_type eq 'SC_ARY') { 




2196




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'scalar_data_type' ); 




2197




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2198




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2199




 





 





 





 





 





 



         } 




2200




 





 





 





 





 





 



         elsif ($cont_type eq 'RW_ARY') { 




2201




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'row_data_type' ); 




2202




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2203




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2204




 





 





 





 





 





 



         } 




2205




 





 





 





 





 





 



         elsif ($cont_type eq 'CONN') { 




2206




 





 





 





 





 





 



             # Not implemented yet. 




2207




 





 





 





 





 





 



         } 




2208




 





 





 





 





 





 



         elsif ($cont_type eq 'CURSOR') { 




2209




 





 





 





 





 





 



             if (my $view_node = (@{$rtn_var_node->get_child_nodes( 'view' )})[0]) { 




2210




 





 





 





 





 





 



                 # Since we got here, cursor will be defined within curr rtn, regardless of share or not. 




2211




 





 





 





 





 





 



                 my $query_expr = $builder->build_query_query_expr( $view_node ); 




2212




 





 





 





 





 





 



                 my $order_by_clause = $builder->build_query_window_clause( $view_node ); 




2213




 





 





 





 





 





 



                 my $updatability_clause 




2214




 





 





 





 





 





 



                     = $rtn_var_node->get_attribute( 'curs_for_update' ) ? 'FOR UPDATE' 




2215




 





 





 





 





 





 



                     :                                                     'FOR READ ONLY'; # TODO: [ OF  ] 




2216




 





 





 





 





 





 



                 # TODO: sensitivity, scrollability, holdability, returnability 




2217




 





 





 





 





 





 



                 my $cursor_spec = $query_expr . ' ' . $order_by_clause . ' ' . $updatability_clause; 




2218




 





 





 





 





 





 



                 push @rtn_var_declare_sql, 'DECLARE ' . $var_name . ' CURSOR FOR ' . $cursor_spec . ';'; 




2219




 





 





 





 





 





 



             } 




2220




 





 





 





 





 





 



             else { 




2221




 





 





 





 





 





 



                 # Not implemented yet; but also not sure of proper way to implement. 




2222




 





 





 





 





 





 



                 # If we got here then cursor had been declared in diff rtn and passed to curr one. 




2223




 





 





 





 





 





 



                 # We can't just make another copy of decl since may use vars/args/etc of other rtn. 




2224




 





 





 





 





 





 



                 push @rtn_var_declare_sql, 'DECLARE ' . $var_name . ';'; 




2225




 





 





 





 





 





 



             } 




2226




 





 





 





 





 





 



         } 




2227




 





 





 





 





 





 



         elsif ($cont_type eq 'LIST') { 




2228




 





 





 





 





 





 



             # Not implemented yet. 




2229




 





 





 





 





 





 



         } 




2230




 





 





 





 





 





 



         else {} 




2231




 





 





 





 





 





 



     } 




2232




 





 





 





 





 





 



     my @rtn_stmt_sql = (); 




2233




 





 





 





 





 





 



     for my $rtn_stmt_node (@{$routine_node->get_child_nodes( 'routine_stmt' )}) { 




2234




 





 





 





 





 





 



         push @rtn_stmt_sql, $builder->build_dmanip_routine_stmt( $rtn_stmt_node ); 




2235




 





 





 





 





 





 



     } 




2236




 





 





 





 





 





 



     my $atomic_clause = $is_atomic ? 'ATOMIC ' : $EMPTY_STR; 




2237




 





 





 





 





 





 



     return join ' ', 




2238




 





 





 





 





 





 



         # TODO: proper handling of vars declared within 'BLOCK' routines, when in Oracle syntax. 




2239




 





 





 





 





 





 



         ($is_ora_routines ? 'VAR ' : 'BEGIN ' . $atomic_clause), 




2240




 





 





 





 





 





 



         @rtn_var_declare_sql, 




2241




 





 





 





 





 





 



         ($is_ora_routines ? 'BEGIN ' . $atomic_clause : $EMPTY_STR), 




2242




 





 





 





 





 





 



         @rtn_stmt_sql, 




2243




 





 





 





 





 





 



         'END;' 




2244




 





 





 





 





 





 



     ; 




2245




 





 





 





 





 





 



 } 




2246




 





 





 





 





 





 



   




2247




 





 





 





 





 





 



 ###################################################################### 




2248




 





 





 





 





 





 



   




2249




 





 





 





 





 





 



 sub build_dmanip_routine_stmt { 




2250




 





 





 





 





 





 



     # SQL:2003, 13.5 "" (p790) 




2251




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2252




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_stmt', 




2253




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2254




 





 





 





 





 





 



     if (my $compound_stmt_routine = $rtn_stmt_node->get_attribute( 'block_routine' )) { 




2255




 





 





 





 





 





 



         return $builder->build_dmanip_routine_body( $compound_stmt_routine ); 




2256




 





 





 





 





 





 



     } 




2257




 





 





 





 





 





 



     elsif (my $assign_dest_node = $rtn_stmt_node->get_attribute( 'assign_dest' ) || 




2258




 





 





 





 





 





 



             $rtn_stmt_node->get_attribute( 'assign_dest' )) { 




2259




 





 





 





 





 





 



         my $dest = $builder->build_identifier_element( $assign_dest_node ); 




2260




 





 





 





 





 





 



         my $src = $builder->build_expr( 




2261




 





 





 





 





 





 



             $rtn_stmt_node->get_child_nodes( 'routine_expr' )->[0] ); 




2262




 





 





 





 





 





 



         if ($builder->{$PROP_ORA_ROUTINES}) { 




2263




 





 





 





 





 





 



             return $dest . ' := ' . $src . ';' . "\n"; 




2264




 





 





 





 





 





 



         } 




2265




 





 





 





 





 





 



         else { 




2266




 





 





 





 





 





 



             return 'SET ' . $dest . ' = ' . $src . ';' . "\n"; 




2267




 





 





 





 





 





 



         } 




2268




 





 





 





 





 





 



     } 




2269




 





 





 





 





 





 



     elsif ($rtn_stmt_node->get_attribute( 'call_sroutine' )) { 




2270




 





 





 





 





 





 



         return $builder->build_dmanip_call_sroutine( $rtn_stmt_node ); 




2271




 





 





 





 





 





 



     } 




2272




 





 





 





 





 





 



     elsif ($rtn_stmt_node->get_attribute( 'call_uroutine' )) { 




2273




 





 





 





 





 





 



         return $builder->build_dmanip_call_uroutine( $rtn_stmt_node ); 




2274




 





 





 





 





 





 



     } 




2275




 





 





 





 





 





 



     else {} 




2276




 





 





 





 





 





 



 } 




2277




 





 





 





 





 





 



   




2278




 





 





 





 





 





 



 ###################################################################### 




2279




 





 





 





 





 





 



   




2280




 





 





 





 





 





 



 sub build_dmanip_call_sroutine { 




2281




 





 





 





 





 





 



     # Corresponds to these sections: 




2282




 





 





 





 





 





 



     # SQL:2003, 14.2 "" (p815) 




2283




 





 





 





 





 





 



     # SQL:2003, 14.3 "" (p817) 




2284




 





 





 





 





 





 



     # SQL:2003, 14.4 "" (p822) 




2285




 





 





 





 





 





 



     # SQL:2003, 15.2 "" (p886) 




2286




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2287




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_call_sroutine', 




2288




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2289




 





 





 





 





 





 



     my $sroutine = $rtn_stmt_node->get_attribute( 'call_sroutine' ); 




2290




 





 





 





 





 





 



     my %child_exprs = map { ( 




2291




 





 





 





 





 





 



             ($_->get_attribute( 'call_sroutine_cxt' ) || 




2292




 





 





 





 





 





 



                 $_->get_attribute( 'call_sroutine_arg' )) => $_ 




2293




 





 





 





 





 





 



         ) } @{$rtn_stmt_node->get_child_nodes( 'routine_expr' )}; 




2294




 





 





 





 





 





 



     if ($sroutine eq 'RETURN') { 




2295




 





 





 





 





 





 



         my $return_value = $builder->build_expr( $child_exprs{'RETURN_VALUE'} ); 




2296




 





 





 





 





 





 



         return 'RETURN ' . $return_value . ';' . "\n"; # no parens in standard 




2297




 





 





 





 





 





 



     } 




2298




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_OPEN') { # opens a select cursor for reading from (or performs a select if in right context) 




2299




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2300




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2301




 





 





 





 





 





 



         return 'OPEN ' . $cursor_cx_name . ';' . "\n"; 




2302




 





 





 





 





 





 



     } 




2303




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_CLOSE') { # closes a select cursor when you're done with it 




2304




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2305




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2306




 





 





 





 





 





 



         return 'CLOSE ' . $cursor_cx_name . ';' . "\n"; 




2307




 





 





 





 





 





 



     } 




2308




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_FETCH') { # reads a row from an opened cursor and puts it in a row/list variable 




2309




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2310




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2311




 





 





 





 





 





 



         my $fetch_orient = $EMPTY_STR; # TODO: the explicit  options; NEXT is default 




2312




 





 





 





 





 





 



         my $query_dest_name = $builder->build_identifier_element( 




2313




 





 





 





 





 





 



             $child_exprs{'INTO'}->get_attribute( 'query_dest' ) ); 




2314




 





 





 





 





 





 



         return 'FETCH ' . $fetch_orient . ' FROM ' . $cursor_cx_name . ' INTO ' . $query_dest_name . ';' . "\n"; 




2315




 





 





 





 





 





 



     } 




2316




 





 





 





 





 





 



     elsif ($sroutine eq 'SELECT') { # fetches one row from a table/view and puts it in a row/list variable 




2317




 





 





 





 





 





 



         my $view_node = $child_exprs{'SELECT_DEFN'}->get_attribute( 'act_on' ); 




2318




 





 





 





 





 





 



         return $builder->build_query_query_spec( $view_node, 




2319




 





 





 





 





 





 



             $child_exprs{'INTO'}->get_attribute( 'query_dest' ) ) . ';' . "\n"; 




2320




 





 





 





 





 





 



     } 




2321




 





 





 





 





 





 



     elsif ($sroutine eq 'INSERT') { # inserts a row into a table/view 




2322




 





 





 





 





 





 



         my $view_node = $child_exprs{'INSERT_DEFN'}->get_attribute( 'act_on' ); 




2323




 





 





 





 





 





 



         return $builder->build_dmanip_insert_stmt( $view_node ); 




2324




 





 





 





 





 





 



     } 




2325




 





 





 





 





 





 



     elsif ($sroutine eq 'UPDATE') { # updates a row in a table/view 




2326




 





 





 





 





 





 



         my $view_node = $child_exprs{'UPDATE_DEFN'}->get_attribute( 'act_on' ); 




2327




 





 





 





 





 





 



         return $builder->build_dmanip_update_stmt( $view_node ); 




2328




 





 





 





 





 





 



     } 




2329




 





 





 





 





 





 



     elsif ($sroutine eq 'DELETE') { # deletes a row in a table/view 




2330




 





 





 





 





 





 



         my $view_node = $child_exprs{'DELETE_DEFN'}->get_attribute( 'act_on' ); 




2331




 





 





 





 





 





 



         return $builder->build_dmanip_delete_stmt( $view_node ); 




2332




 





 





 





 





 





 



     } 




2333




 





 





 





 





 





 



     elsif ($sroutine eq 'COMMIT') { # commits the current transaction, then starts a new one 




2334




 





 





 





 





 





 



         return 'COMMIT; START TRANSACTION;' . "\n"; 




2335




 





 





 





 





 





 



         # Note: According to the MySQL manual: 




2336




 





 





 





 





 





 



         # For transaction-safe tables, there are actions (other than typing COMMIT) 




2337




 





 





 





 





 





 



         # that will automatically trigger a COMMIT. Requesting a lock will implicitly 




2338




 





 





 





 





 





 



         # commit any outstanding queries. 




2339




 





 





 





 





 





 



     } 




2340




 





 





 





 





 





 



     elsif ($sroutine eq 'ROLLBACK') { # rolls back the current transaction, then starts a new one 




2341




 





 





 





 





 





 



         return 'ROLLBACK; START TRANSACTION;' . "\n"; # TODO: rollback to a named save point only 




2342




 





 





 





 





 





 



     } 




2343




 





 





 





 





 





 



     else {} # There are a bunch more that aren't implemented yet. 




2344




 





 





 





 





 





 



 } 




2345




 





 





 





 





 





 



   




2346




 





 





 





 





 





 



 ###################################################################### 




2347




 





 





 





 





 





 



   




2348




 





 





 





 





 





 



 sub build_dmanip_src_schema_object_name { 




2349




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2350




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_src_schema_object_name', 




2351




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2352




 





 





 





 





 





 



     my $view_type = $view_node->get_attribute( 'view_type' ); 




2353




 





 





 





 





 





 



     my @view_src_nodes = @{$view_node->get_child_nodes( 'view_src' )}; 




2354




 





 





 





 





 





 



     if (@view_src_nodes == 0) { 




2355




 





 





 





 





 





 



         return; # No source at all. 




2356




 





 





 





 





 





 



     } 




2357




 





 





 





 





 





 



     elsif ($view_type eq 'ALIAS' or @view_src_nodes == 1) { 




2358




 





 





 





 





 





 



         my $object_node = $view_src_nodes[0]->get_attribute( 'match' ); 




2359




 





 





 





 





 





 



         if ($object_node->get_primary_parent_attribute()->get_node_type() eq 'schema') { 




2360




 





 





 





 





 





 



             # The only source is a schema object, table or named view; use it directly. 




2361




 





 





 





 





 





 



             return $builder->build_identifier_schema_or_app_obj( $object_node ); 




2362




 





 





 





 





 





 



         } 




2363




 





 





 





 





 





 



         else { 




2364




 





 





 





 





 





 



             # The only source seems to be a sub-query in "from". 




2365




 





 





 





 





 





 



             return; # Adding recursion in all necessary places too complicated for now. 




2366




 





 





 





 





 





 



         } 




2367




 





 





 





 





 





 



     } 




2368




 





 





 





 





 





 



     else { # @view_src_nodes >= 2 




2369




 





 





 





 





 





 



         return; # Manual updates against multiple sources too complicated for now. 




2370




 





 





 





 





 





 



     } 




2371




 





 





 





 





 





 



 } 




2372




 





 





 





 





 





 



   




2373




 





 





 





 





 





 



 ###################################################################### 




2374




 





 





 





 





 





 



   




2375




 





 





 





 





 





 



 sub build_dmanip_insert_stmt { 




2376




 





 





 





 





 





 



     # SQL:2003, 7.3 "" (p298) 




2377




 





 





 





 





 





 



     # SQL:2003, 14.8 "" (p834) 




2378




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2379




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_insert_stmt', 




2380




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2381




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2382




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2383




 





 





 





 





 





 



     my @set_expr_nodes 




2384




 





 





 





 





 





 



         = grep { $_->get_attribute( 'view_part' ) eq 'SET' } 




2385




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




2386




 





 





 





 





 





 



     my @set_fields_list = (); 




2387




 





 





 





 





 





 



     my @set_values_list = (); 




2388




 





 





 





 





 





 



     for my $expr_node (@set_expr_nodes) { 




2389




 





 





 





 





 





 



         push @set_fields_list, $builder->build_identifier_element( 




2390




 





 





 





 





 





 



             $expr_node->get_attribute( 'set_src_field' ) ); 




2391




 





 





 





 





 





 



         push @set_values_list, $builder->build_expr( $expr_node ); 




2392




 





 





 





 





 





 



     } 




2393




 





 





 





 





 





 



     my $insert_fields_and_src = '(' . (join q{, }, @set_fields_list) . ') ' 




2394




 





 





 





 





 





 



         . 'VALUES (' . (join q{, }, @set_values_list) . ')'; 




2395




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2396




 





 





 





 





 





 



     return 'INSERT INTO ' . $object_name . ' ' . $insert_fields_and_src . ';' . "\n"; 




2397




 





 





 





 





 





 



 } 




2398




 





 





 





 





 





 



   




2399




 





 





 





 





 





 



 ###################################################################### 




2400




 





 





 





 





 





 



   




2401




 





 





 





 





 





 



 sub build_dmanip_update_stmt { 




2402




 





 





 





 





 





 



     # SQL:2003, 14.11 "" (p849) 




2403




 





 





 





 





 





 



     # SQL:2003, 14.12 "" (p853) 




2404




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2405




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_update_stmt', 




2406




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2407




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2408




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2409




 





 





 





 





 





 



     my @set_expr_nodes 




2410




 





 





 





 





 





 



         = grep { $_->get_attribute( 'view_part' ) eq 'SET' } 




2411




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




2412




 





 





 





 





 





 



     my @set_clause_list = (); 




2413




 





 





 





 





 





 



     for my $expr_node (@set_expr_nodes) { 




2414




 





 





 





 





 





 



         my $set_target = $builder->build_identifier_element( 




2415




 





 





 





 





 





 



             $expr_node->get_attribute( 'set_src_field' ) ); 




2416




 





 





 





 





 





 



         my $update_source = $builder->build_expr( $expr_node ); 




2417




 





 





 





 





 





 



         push @set_clause_list, $set_target . ' = ' . $update_source; 




2418




 





 





 





 





 





 



     } 




2419




 





 





 





 





 





 



     my $set_clause = 'SET ' . (join q{, }, @set_clause_list); 




2420




 





 





 





 





 





 



     my $where_clause = $builder->build_query_where_clause( $view_node ); 




2421




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2422




 





 





 





 





 





 



     return 'UPDATE ' . $object_name . ' ' . $set_clause . ' ' . $where_clause . ';' . "\n"; 




2423




 





 





 





 





 





 



 } 




2424




 





 





 





 





 





 



   




2425




 





 





 





 





 





 



 ###################################################################### 




2426




 





 





 





 





 





 



   




2427




 





 





 





 





 





 



 sub build_dmanip_delete_stmt { # SQL:2003, 14.7 "" (p831) 




2428




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2429




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_delete_stmt', 




2430




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2431




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2432




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2433




 





 





 





 





 





 



     my $where_clause = $builder->build_query_where_clause( $view_node ); 




2434




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2435




 





 





 





 





 





 



     return 'DELETE FROM ' . $object_name . ' ' . $where_clause . ';' . "\n"; 




2436




 





 





 





 





 





 



 } 




2437




 





 





 





 





 





 



   




2438




 





 





 





 





 





 



 ###################################################################### 




2439




 





 





 





 





 





 



   




2440




 





 





 





 





 





 



 sub build_dmanip_call_uroutine { 




2441




 





 





 





 





 





 



     # SQL:2003 ...  ... 




2442




 





 





 





 





 





 



     # SQL:2003, 15.1 "" (p885) 




2443




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2444




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_call_uroutine', 




2445




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2446




 





 





 





 





 





 



     my $uroutine = $rtn_stmt_node->get_attribute( 'call_uroutine' ); 




2447




 





 





 





 





 





 



     my $uroutine_name = $builder->build_identifier_schema_or_app_obj( $uroutine ); 




2448




 





 





 





 





 





 



     my %uroutine_arg_exprs 




2449




 





 





 





 





 





 



         = map { ($_->get_attribute( 'call_uroutine_arg' )->get_self_id() => $_) } 




2450




 





 





 





 





 





 



           @{$rtn_stmt_node->get_child_nodes( 'routine_expr' )}; 




2451




 





 





 





 





 





 



     # Note: The build_expr() calls are done below to ensure the arg values are 




2452




 





 





 





 





 





 



     # defined in the same order they are output; this lets optional insertion 




2453




 





 





 





 





 





 



     # of positionally determined host params (and their mapping) to work right. 




2454




 





 





 





 





 





 



     my $arg_val_list = join q{, }, 




2455




 





 





 





 





 





 



         map { $uroutine_arg_exprs{$_->get_self_id()} 




2456




 





 





 





 





 





 



               ? $builder->build_expr( $uroutine_arg_exprs{$_->get_self_id()} ) 




2457




 





 





 





 





 





 



               : 'NULL' } 




2458




 





 





 





 





 





 



         @{$uroutine->get_child_nodes( 'routine_arg' )}; 




2459




 





 





 





 





 





 



     #  ::= CALL  




2460




 





 





 





 





 





 



     return 'CALL ' . $uroutine_name . ($arg_val_list ? '(' . $arg_val_list . ')' : $EMPTY_STR) . ';' . "\n"; 




2461




 





 





 





 





 





 



 } 




2462




 





 





 





 





 





 



   




2463




 





 





 





 





 





 



 ###################################################################### 




2464




 





 





 





 





 





 



   




2465




 





 





 





 





 





 



 sub substitute_macros { 




2466




 





 





 





 





 





 



     my ($builder, $str, $subs) = @_; 




2467




 





 





 





 





 





 



     while (my ($key,$value) = each %{$subs}) { 




2468




 





 





 





 





 





 



         $str =~ s/ \{ $key \} /$value/x; 




2469




 





 





 





 





 





 



     } 




2470




 





 





 





 





 





 



     return $str; 




2471




 





 





 





 





 





 



 } 




2472




 





 





 





 





 





 



   




2473




 





 





 





 





 





 



 ###################################################################### 




2474




 





 





 





 





 





 



   




2475




 





 





 





 





 





 



 sub find_scalar_domain_for_row_domain_field { 




2476




 





 





 





 





 





 



     my ($builder, $scalar_data_type_node, $row_domain_node) = @_; 




2477




 





 





 





 





 





 



     my @candidates = grep { $_->get_attribute( 'data_type' )->get_self_id() eq $scalar_data_type_node->get_self_id() } 




2478




 





 





 





 





 





 



         @{$row_domain_node->get_primary_parent_attribute()->get_child_nodes( 'scalar_domain' )}; 




2479




 





 





 





 





 





 



     return $candidates[0] || $scalar_data_type_node; 




2480




 





 





 





 





 





 



 } 




2481




 





 





 





 





 





 



   




2482




 





 





 





 





 





 



 ###################################################################### 




2483




 





 





 





 





 





 



   




2484




 





 





 





 





 





 



 sub _scalar_data_type_of_node { 




2485




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2486




 





 





 





 





 





 



     $atnm ||= 'scalar_data_type'; 




2487




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2488




 





 





 





 





 





 



     if ($dt_or_dom_node->get_node_type() eq 'scalar_domain') { 




2489




 





 





 





 





 





 



         $dt_or_dom_node = $dt_or_dom_node->get_attribute( 'data_type' ); 




2490




 





 





 





 





 





 



     } 




2491




 





 





 





 





 





 



     return $dt_or_dom_node; 




2492




 





 





 





 





 





 



 } 




2493




 





 





 





 





 





 



   




2494




 





 





 





 





 





 



 sub _row_data_type_of_node { 




2495




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2496




 





 





 





 





 





 



     $atnm ||= 'row_data_type'; 




2497




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2498




 





 





 





 





 





 



     if ($dt_or_dom_node->get_node_type() eq 'row_domain') { 




2499




 





 





 





 





 





 



         $dt_or_dom_node = $dt_or_dom_node->get_attribute( 'data_type' ); 




2500




 





 





 





 





 





 



     } 




2501




 





 





 





 





 





 



     return $dt_or_dom_node; 




2502




 





 





 





 





 





 



 } 




2503




 





 





 





 





 





 



   




2504




 





 





 





 





 





 



 sub _row_domain_of_node { 




2505




 





 





 





 





 





 



     # returns domain or nothing 




2506




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2507




 





 





 





 





 





 



     $atnm ||= 'row_data_type'; 




2508




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2509




 





 





 





 





 





 



     return $dt_or_dom_node 




2510




 





 





 





 





 





 



         if $dt_or_dom_node->get_node_type() eq 'row_domain'; 




2511




 





 





 





 





 





 



     return; 




2512




 





 





 





 





 





 



 } 




2513




 





 





 





 





 





 



   




2514




 





 





 





 





 





 



 ###################################################################### 




2515




 





 





 





 





 





 



 # This is a 'protected' method; only sub-classes should invoke it. 




2516




 





 





 





 





 





 



   




2517




 





 





 





 





 





 



 sub _throw_error_message { 




2518




 





 





 





 





 





 



     my ($builder, $msg_key, $msg_vars) = @_; 




2519




 





 





 





 





 





 



     # Throws an exception consisting of an object. 




2520




 





 





 





 





 





 



     ref $msg_vars eq 'HASH' or $msg_vars = {}; 




2521




 





 





 





 





 





 



     for my $var_key (keys %{$msg_vars}) { 




2522




 





 





 





 





 





 



         if (ref $msg_vars->{$var_key} eq 'ARRAY') { 




2523




 





 





 





 





 





 



             $msg_vars->{$var_key} = 'PERL_ARRAY:[' . (join q{,},map {$_||$EMPTY_STR} @{$msg_vars->{$var_key}}) . ']'; 




2524




 





 





 





 





 





 



         } 




2525




 





 





 





 





 





 



     } 




2526




 





 





 





 





 





 



     die Locale::KeyedText->new_message( $msg_key, $msg_vars ); 




2527




 





 





 





 





 





 



 } 




2528




 





 





 





 





 





 



   




2529




 





 





 





 





 





 



 sub _assert_arg_node_type { 




2530




 





 





 





 





 





 



     my ($builder, $meth_name, $arg_name, $exp_node_types, $arg_value) = @_; 




2531




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_UNDEF', 




2532




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name } ) 




2533




 





 





 





 





 





 



         if !defined $arg_value; 




2534




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_NO_NODE', 




2535




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name, 'ARGVL' => $arg_value } ) 




2536




 





 





 





 





 





 



         if !ref $arg_value or !UNIVERSAL::isa( $arg_value, 'Rosetta::Model::Node' ); 




2537




 





 





 





 





 





 



     return 




2538




 





 





 





 





 





 



         if @{$exp_node_types} == 0; # any Node type is acceptable 




2539




 





 





 





 





 





 



     my $given_node_type = $arg_value->get_node_type(); 




2540




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_WRONG_NODE_TYPE', 




2541




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name, 




2542




 





 





 





 





 





 



         'EXPNTYPE' => $exp_node_types, 'ARGNTYPE' => $given_node_type } ) 




2543




 





 





 





 





 





 



         if !grep { $given_node_type eq $_ } @{$exp_node_types}; 




2544




 





 





 





 





 





 



     # If we get here, $arg_value is acceptable to the method. 




2545




 





 





 





 





 





 



 } 




2546




 





 





 





 





 





 



   




2547




 





 





 





 





 





 



 ###################################################################### 




2548




 





 





 





 





 





 



 ###################################################################### 




2549




 





 





 





 





 





 



   




2550




 





 





 





 





 





 



 1; 




2551




 





 





 





 





 





 



 __END__
    my ($builder, $view_node) = @_;
    $builder->_assert_arg_node_type( 'build_query_table_expr',
        'VIEW_NODE', ['view'], $view_node );
    return $builder->build_query_from_clause( $view_node )
        . $builder->build_query_where_clause( $view_node )
        . $builder->build_query_group_clause( $view_node )
        . $builder->build_query_having_clause( $view_node )
        . $builder->build_query_window_clause( $view_node );
}

######################################################################

sub build_query_from_clause {
    # SQL:2003, 7.5 "" (p301)
    # SQL:2003, 7.6 "" (p303) 




1312




 





 





 





 





 





 



     # SQL:2003, 7.7 "" (p312) 




1313




 





 





 





 





 





 



     # Method assumes that $view_node.view_type ne 'COMPOUND'; 




1314




 





 





 





 





 





 



     # method should never be invoked for those kinds of views. 




1315




 





 





 





 





 





 



     # Function returns empty string if view has no 'from' clause (a rarity). 




1316




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1317




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_from_clause', 




1318




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1319




 





 





 





 





 





 



     my $view_type = $view_node->get_attribute( 'view_type' ); 




1320




 





 





 





 





 





 



     my @view_src_nodes = @{$view_node->get_child_nodes( 'view_src' )}; 




1321




 





 





 





 





 





 



     my @view_join_nodes = @{$view_node->get_child_nodes( 'view_join' )}; 




1322




 





 





 





 





 





 



     if (@view_src_nodes == 0) { 




1323




 





 





 





 





 





 



         # There are no sources, and hence, no 'from' clause. 




1324




 





 





 





 





 





 



         return $EMPTY_STR; 




1325




 





 





 





 





 





 



     } 




1326




 





 





 





 





 





 



     elsif ($view_type eq 'ALIAS' or @view_src_nodes == 1) { 




1327




 





 





 





 





 





 



         # Trivial case: There is exactly one source, aka a single ""; 




1328




 





 





 





 





 





 



         # it can be either a table or named view or subquery. 




1329




 





 





 





 





 





 



         return "\n" . 'FROM ' . $builder->build_query_table_factor( $view_src_nodes[0] ); 




1330




 





 





 





 





 





 



     } 




1331




 





 





 





 





 





 



     else { 




1332




 





 





 





 





 





 



         # Complex case: There are 2 or more sources that are being joined. 




1333




 





 





 





 





 





 



         # The first step is to determine the join order, and only afterwards are 




1334




 





 





 





 





 





 



         # each  rendered into SQL; each  must be 




1335




 





 





 





 





 





 



         # generated in appearance order, so positional host param mapping works right. 




1336




 





 





 





 





 





 



         # Note: This code isn't very smart and assumes that all the view_join Nodes 




1337




 





 





 





 





 





 



         # are declared in the same order they should be output, even if their is 




1338




 





 





 





 





 





 



         # other evidence to the contrary.  This code can be smartened later. 




1339




 





 





 





 





 





 



         # This code also assumes that the ROS M is correct, such that all defined 




1340




 





 





 





 





 





 



         # view_src Nodes are involved in a single common view_join; there should be 




1341




 





 





 





 





 





 



         # exactly one fewer view_join Node than there are view_src Nodes. 




1342




 





 





 





 





 





 



         # TODO: Support the Oracle-8 way of putting join conditions in WHERE. 




1343




 





 





 





 





 





 



         my @sql_fragment_list = (); 




1344




 





 





 





 





 





 



         push @sql_fragment_list, $builder->build_query_table_factor( 




1345




 





 





 





 





 





 



             $view_join_nodes[0]->get_attribute( 'lhs_src' ) ); 




1346




 





 





 





 





 





 



         for my $view_join_node (@view_join_nodes) { 




1347




 





 





 





 





 





 



             my $join_op = $view_join_node->get_attribute( 'join_op' ); 




1348




 





 





 





 





 





 



             push @sql_fragment_list, "\n" 




1349




 





 





 





 





 





 



                  . ( $join_op eq 'CROSS' ? 'CROSS JOIN' 




1350




 





 





 





 





 





 



                    : $join_op eq 'INNER' ? 'INNER JOIN' 




1351




 





 





 





 





 





 



                    : $join_op eq 'LEFT'  ? 'LEFT OUTER JOIN' 




1352




 





 





 





 





 





 



                    : $join_op eq 'RIGHT' ? 'RIGHT OUTER JOIN' 




1353




 





 





 





 





 





 



                    : $join_op eq 'FULL'  ? 'FULL OUTER JOIN' 




1354




 





 





 





 





 





 



                    :                       undef # we should never get here 




1355




 





 





 





 





 





 



                    ); 




1356




 





 





 





 





 





 



             push @sql_fragment_list, $builder->build_query_table_factor( 




1357




 





 





 





 





 





 



                 $view_join_node->get_attribute( 'rhs_src' ) ); 




1358




 





 





 





 





 





 



             my @join_on_sql = (); 




1359




 





 





 





 





 





 



             for my $view_join_field_node (@{$view_join_node->get_child_nodes( 'view_join_field' )}) { 




1360




 





 





 





 





 





 



                 my $lhs_src_field_name = $builder->build_identifier_view_src_field( 




1361




 





 





 





 





 





 



                     $view_join_field_node->get_attribute( 'lhs_src_field' ) ); 




1362




 





 





 





 





 





 



                 my $rhs_src_field_name = $builder->build_identifier_view_src_field( 




1363




 





 





 





 





 





 



                     $view_join_field_node->get_attribute( 'rhs_src_field' ) ); 




1364




 





 





 





 





 





 



                 push @join_on_sql, $rhs_src_field_name . ' = ' . $lhs_src_field_name; 




1365




 





 





 





 





 





 



             } 




1366




 





 





 





 





 





 



             push @sql_fragment_list, 'ON ' . (join ' AND ', @join_on_sql); 




1367




 





 





 





 





 





 



         } 




1368




 





 





 





 





 





 



         return "\n" . 'FROM ' . (join ' ', @sql_fragment_list); 




1369




 





 





 





 





 





 



     } 




1370




 





 





 





 





 





 



 } 




1371




 





 





 





 





 





 



   




1372




 





 





 





 





 





 



 sub build_query_table_factor { # SQL:2003, 7.6 "" (p303) 




1373




 





 





 





 





 





 



     my ($builder, $view_src_node) = @_; 




1374




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_table_factor', 




1375




 





 





 





 





 





 



         'VIEW_SRC_NODE', ['view_src'], $view_src_node ); 




1376




 





 





 





 





 





 



     # Maybe TODO:  




1377




 





 





 





 





 





 



     my $correlation_name = $builder->build_identifier_element( $view_src_node ); 




1378




 





 





 





 





 





 



     my $match_node = $view_src_node->get_attribute( 'match' ); 




1379




 





 





 





 





 





 



     my $match_name = $builder->build_identifier_schema_or_app_obj( $match_node ); 




1380




 





 





 





 





 





 



     if ($match_node->get_node_type() eq 'view') { 




1381




 





 





 





 





 





 



         if ($match_node->get_primary_parent_attribute()->get_node_type() eq 'view') { 




1382




 





 





 





 





 





 



             # The view we are matching is a subquery. 




1383




 





 





 





 





 





 



             if ($builder->{$PROP_INLINE_SUBQ}) { 




1384




 





 





 





 





 





 



                 # Embed an anonymous subquery; argument passing is not yet supported. 




1385




 





 





 





 





 





 



                 my $query_expression = $builder->build_query_query_expr( $match_node ); 




1386




 





 





 





 





 





 



                 return '(' . $query_expression . ') AS ' . $correlation_name; 




1387




 





 





 





 





 





 



             } 




1388




 





 





 





 





 





 



             else { 




1389




 





 





 





 





 





 



                 # Call a named subquery; argument passing is supported. 




1390




 





 





 





 





 





 



                 my %src_args_to_view_exprs 




1391




 





 





 





 





 





 



                     = map { ($_->get_attribute( 'call_src_arg' )->get_self_id() => $_) } 




1392




 





 





 





 





 





 



                       grep { $_->get_attribute( 'view_part' ) eq 'FROM' } 




1393




 





 





 





 





 





 



                       @{$view_src_node->get_primary_parent_attribute()->get_child_nodes( 'view_expr' )}; 




1394




 





 





 





 





 





 



                 my %view_args_to_src_args 




1395




 





 





 





 





 





 



                     = map { ($_->get_attribute( 'match_view_arg' )->get_self_id() => $_) } 




1396




 





 





 





 





 





 



                       @{$view_src_node->get_child_nodes( 'view_src_arg' )}; 




1397




 





 





 





 





 





 



                 # Note: The build_expr() calls are done below to ensure the arg values are 




1398




 





 





 





 





 





 



                 # defined in the same order they are output; this lets optional insertion 




1399




 





 





 





 





 





 



                 # of positionally determined host params (and their mapping) to work right. 




1400




 





 





 





 





 





 



                 my $arg_list = join q{, }, 




1401




 





 





 





 





 





 



                     map { ($_ ? $builder->build_expr( $_ ) : 'NULL') } 




1402




 





 





 





 





 





 



                     map { $src_args_to_view_exprs{$view_args_to_src_args{$_->get_self_id()}->get_self_id()} } 




1403




 





 





 





 





 





 



                     @{$match_node->get_child_nodes( 'view_arg' )}; 




1404




 





 





 





 





 





 



                 return $match_name 




1405




 





 





 





 





 





 



                        . ($arg_list ? '(' . $arg_list . ')' : $EMPTY_STR) 




1406




 





 





 





 





 





 



                        . ' AS ' . $correlation_name; 




1407




 





 





 





 





 





 



             } 




1408




 





 





 





 





 





 



         } 




1409




 





 





 





 





 





 



         else { 




1410




 





 





 





 





 





 



             # The view we are matching is a schema object. 




1411




 





 





 





 





 





 



             return $match_name . ' AS ' . $correlation_name; 




1412




 





 





 





 





 





 



         } 




1413




 





 





 





 





 





 



     } 




1414




 





 





 





 





 





 



     else { # the source node is a base table schema object or a local variable of some kind 




1415




 





 





 





 





 





 



         return $match_name . ' AS ' . $correlation_name; 




1416




 





 





 





 





 





 



     } 




1417




 





 





 





 





 





 



 } 




1418




 





 





 





 





 





 



   




1419




 





 





 





 





 





 



 ###################################################################### 




1420




 





 





 





 





 





 



   




1421




 





 





 





 





 





 



 sub build_query_where_clause { # SQL:2003, 7.8 "" (p319) 




1422




 





 





 





 





 





 



     # Function returns empty string if view has no where clause. 




1423




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1424




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_where_clause', 




1425




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1426




 





 





 





 





 





 



     my @expr_list 




1427




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1428




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'WHERE' } 




1429




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1430




 





 





 





 





 





 



     return @expr_list ? "\n" . 'WHERE ' . $expr_list[0] : $EMPTY_STR; 




1431




 





 





 





 





 





 



 } 




1432




 





 





 





 





 





 



   




1433




 





 





 





 





 





 



 ###################################################################### 




1434




 





 





 





 





 





 



   




1435




 





 





 





 





 





 



 sub build_query_group_clause { # SQL:2003, 7.9 "" (p320) 




1436




 





 





 





 





 





 



     # Function returns empty string if view has no group by clause. 




1437




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1438




 





 





 





 





 





 



     my @expr_list 




1439




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1440




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'GROUP' } 




1441




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1442




 





 





 





 





 





 



     return @expr_list ? "\n" . 'GROUP BY ' . (join q{, }, @expr_list) : $EMPTY_STR; 




1443




 





 





 





 





 





 



     # Notes: Within build_expr(): 




1444




 





 





 





 





 





 



     #  implemented by COL basic_expr_type, 




1445




 





 





 





 





 





 



     #  and  implemented by LIST basic_expr_type, 




1446




 





 





 





 





 





 



     #  impl by ROSMN named GB_SETS, 




1447




 





 





 





 





 





 



     #  impl by ROSMN named GB_RLUP, 




1448




 





 





 





 





 





 



     #  impl by ROSMN named GB_CUBE. 




1449




 





 





 





 





 





 



     # Note:  has opt , looks redundant w SEL DIST|ALL; not impl. 




1450




 





 





 





 





 





 



 } 




1451




 





 





 





 





 





 



   




1452




 





 





 





 





 





 



 ###################################################################### 




1453




 





 





 





 





 





 



   




1454




 





 





 





 





 





 



 sub build_query_having_clause { # SQL:2003, 7.10 "" (p329) 




1455




 





 





 





 





 





 



     # Function returns empty string if view has no having clause. 




1456




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1457




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_having_clause', 




1458




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1459




 





 





 





 





 





 



     my @expr_list 




1460




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1461




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'HAVING' } 




1462




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1463




 





 





 





 





 





 



     return @expr_list ? "\n" . 'HAVING ' . $expr_list[0] : $EMPTY_STR; 




1464




 





 





 





 





 





 



 } 




1465




 





 





 





 





 





 



   




1466




 





 





 





 





 





 



 ###################################################################### 




1467




 





 





 





 





 





 



   




1468




 





 





 





 





 





 



 sub build_query_window_clause { # SQL:2003, 7.11 "" (p331) 




1469




 





 





 





 





 





 



     # Function returns empty string if view has no window clause. 




1470




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1471




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_window_clause', 




1472




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1473




 





 





 





 





 





 



     # TODO: I need to first update Rosetta::Model a bit re the various 




1474




 





 





 





 





 





 



     # parts of a , then fix here.  Meanwhile, I dump what I got. 




1475




 





 





 





 





 





 



     # Also see SQL:2003, 10.10 "" (p517) for future reference. 




1476




 





 





 





 





 





 



     my @order_list 




1477




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1478




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'ORDER' } 




1479




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1480




 





 





 





 





 





 



     my @maxr_list 




1481




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1482




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'MAXR' } 




1483




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1484




 





 





 





 





 





 



     my @skipr_list 




1485




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1486




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'SKIPR' } 




1487




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1488




 





 





 





 





 





 



     return (@order_list ? "\n" . 'ORDER BY ' . (join q{, }, @order_list) : $EMPTY_STR) 




1489




 





 





 





 





 





 



            . (@maxr_list ? "\n" . 'LIMIT ' . $maxr_list[0] : $EMPTY_STR) 




1490




 





 





 





 





 





 



            . (@skipr_list ? "\n" . 'OFFSET ' . $skipr_list[0] : $EMPTY_STR); 




1491




 





 





 





 





 





 



 } 




1492




 





 





 





 





 





 



   




1493




 





 





 





 





 





 



 ###################################################################### 




1494




 





 





 





 





 





 



   




1495




 





 





 





 





 





 



 sub build_query_query_spec { 




1496




 





 





 





 





 





 



     # SQL:2003, 7.12 "" (p341) 




1497




 





 





 





 





 





 



     # SQL:2003, 14.5 "" (p824) 




1498




 





 





 





 





 





 



     my ($builder, $view_node, $into_dest_node) = @_; 




1499




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_query_spec', 




1500




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1501




 





 





 





 





 





 



     defined $into_dest_node and $builder->_assert_arg_node_type( 'build_query_query_spec', 




1502




 





 





 





 





 





 



         'INTO_DEST_NODE', ['routine_arg','routine_var'], $into_dest_node ); 




1503




 





 





 





 





 





 



     # Method assumes that $view_node.view_type ne 'COMPOUND'; 




1504




 





 





 





 





 





 



     # method should never be invoked for those kinds of views. 




1505




 





 





 





 





 





 



     my $set_quantifier = $view_node->get_attribute( 'distinct_rows' ) ? 'DISTINCT' : 'ALL'; 




1506




 





 





 





 





 





 



     my $select_list = $builder->build_query_select_list( $view_node ); 




1507




 





 





 





 





 





 



     my $into_clause = $into_dest_node ? "\n" . 'INTO ' . $builder->build_identifier_element( $into_dest_node ) : $EMPTY_STR; 




1508




 





 





 





 





 





 



     my $table_expression = $builder->build_query_table_expr( $view_node ); 




1509




 





 





 





 





 





 



     return "\n" . 'SELECT ' . $set_quantifier . ' ' . $select_list . $into_clause . $table_expression; 




1510




 





 





 





 





 





 



 } 




1511




 





 





 





 





 





 



   




1512




 





 





 





 





 





 



 ###################################################################### 




1513




 





 





 





 





 





 



   




1514




 





 





 





 





 





 



 sub build_query_select_list { # SQL:2003, 7.12 "" (p341) 




1515




 





 





 





 





 





 



     # Method returns comma-delimited list expression where each list item is a 




1516




 





 





 





 





 





 



     # " ::=  AS ". 




1517




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1518




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_select_list', 




1519




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1520




 





 





 





 





 





 



     if ($view_node->get_attribute( 'view_type' ) eq 'ALIAS') { 




1521




 





 





 





 





 





 



         # Each result column must match a source column exactly. 




1522




 





 





 





 





 





 



         # Every source table/view result column or var field is output, with the same name. 




1523




 





 





 





 





 





 



         # It is assumed/required that the view has the same 'row_data_type' as the source. 




1524




 





 





 





 





 





 



         # While '*' would conceptually work here, we still explicitly enumerate col name list 




1525




 





 





 





 





 





 



         # so compound selects and select-intos don't break when original create tbl/vw statement 




1526




 





 





 





 





 





 



         # had declared columns in a different order than our row-data-type does. 




1527




 





 





 





 





 





 



         my $row_data_type_node = $builder->_row_data_type_of_node( $view_node ); 




1528




 





 





 





 





 





 



         return join q{, } . "\n", 




1529




 





 





 





 





 





 



             map { $builder->build_identifier_element( $_ ) } 




1530




 





 





 





 





 





 



             @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}; 




1531




 





 





 





 





 





 



     } 




1532




 





 





 





 





 





 



     else { # view_type ne 'ALIAS' 




1533




 





 





 





 





 





 



         # Each result column may come from an arbitrarily complex expression. 




1534




 





 





 





 





 





 



         # We have three statements below instead of one because we want the result cols shown 




1535




 





 





 





 





 





 



         # in order of the view's "row_data_type_field" Nodes, not the order of the 'view_part' if different. 




1536




 





 





 





 





 





 



         my %select_list_view_fields 




1537




 





 





 





 





 





 



             = map { ($_->get_attribute( 'si_row_field' )->get_self_id() => $_->get_attribute( 'src_field' )) } 




1538




 





 





 





 





 





 



               @{$view_node->get_child_nodes( 'view_field' )}; # note: 'src_field' may be undefined 




1539




 





 





 





 





 





 



         my %select_list_view_exprs 




1540




 





 





 





 





 





 



             = map { ($_->get_attribute( 'set_result_field' )->get_self_id() => $_) } 




1541




 





 





 





 





 





 



               grep { $_->get_attribute( 'view_part' ) eq 'RESULT' } 




1542




 





 





 





 





 





 



               @{$view_node->get_child_nodes( 'view_expr' )}; 




1543




 





 





 





 





 





 



         # Note: The build_expr() calls are done below to ensure the arg values are 




1544




 





 





 





 





 





 



         # defined in the same order they are output; this lets optional insertion 




1545




 





 





 





 





 





 



         # of positionally determined host params (and their mapping) to work right. 




1546




 





 





 





 





 





 



         my $row_data_type_node = $builder->_row_data_type_of_node( $view_node ); 




1547




 





 





 





 





 





 



         return join q{, } . "\n", 




1548




 





 





 





 





 





 



             map { ($select_list_view_fields{$_->get_self_id()} 




1549




 





 





 





 





 





 



                    ? $builder->build_identifier_view_src_field( $select_list_view_fields{$_->get_self_id()} ) 




1550




 





 





 





 





 





 



                    : $select_list_view_exprs{$_->get_self_id()} 




1551




 





 





 





 





 





 



                    ? $builder->build_expr( $select_list_view_exprs{$_->get_self_id()} ) 




1552




 





 





 





 





 





 



                    : 'NULL') 




1553




 





 





 





 





 





 



                 . ' AS ' . $builder->build_identifier_element( $_ ) } 




1554




 





 





 





 





 





 



             @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}; 




1555




 





 





 





 





 





 



         # Note that the default of NULL thing deals with view's row field that don't have any view_expr or src_field. 




1556




 





 





 





 





 





 



         # TODO IF NOT WRONG/OUTDATED: Note that the 'view_field' Nodes we actually need may be in a parent view 




1557




 





 





 





 





 





 



         # of the current view; right now we only are looking in the current view. 




1558




 





 





 





 





 





 



     } 




1559




 





 





 





 





 





 



 } 




1560




 





 





 





 





 





 



   




1561




 





 





 





 





 





 



 ###################################################################### 




1562




 





 





 





 





 





 



   




1563




 





 





 





 





 





 



 sub build_query_query_expr { # SQL:2003, 7.13 "" (p351) 




1564




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1565




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_query_expr', 




1566




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1567




 





 





 





 





 





 



     my $view_type = $view_node->get_attribute( 'view_type' ); 




1568




 





 





 





 





 





 



     my $with_clause = $EMPTY_STR; 




1569




 





 





 





 





 





 



     if (!$builder->{$PROP_INLINE_SUBQ}) { 




1570




 





 





 





 





 





 



         my @with_list = (); 




1571




 





 





 





 





 





 



         my $recursive = 0; 




1572




 





 





 





 





 





 



         for my $child_view_node (@{$view_node->get_child_nodes( 'view' )}) { 




1573




 





 





 





 





 





 



             if ($child_view_node->get_attribute( 'recursive' )) { 




1574




 





 





 





 





 





 



                 $recursive = 1; 




1575




 





 





 





 





 





 



             } 




1576




 





 





 





 





 





 



             my $with_item = $builder->build_identifier_element( $child_view_node ); 




1577




 





 





 





 





 





 



             if (my @child_arg_nodes = @{$child_view_node->get_child_nodes( 'view_arg' )}) { 




1578




 





 





 





 





 





 



                 $with_item .= '(' . (join q{, }, 




1579




 





 





 





 





 





 



                     map { $builder->build_identifier_element( $_ ) } 




1580




 





 





 





 





 





 



                     @child_arg_nodes) . ')'; 




1581




 





 





 





 





 





 



             } 




1582




 





 





 





 





 





 



             $with_item .= ' AS (' . $builder->build_query_query_expr( $child_view_node ) . ')'; 




1583




 





 





 





 





 





 



             push @with_list, $with_item; 




1584




 





 





 





 





 





 



         } 




1585




 





 





 





 





 





 



         if (@with_list) { 




1586




 





 





 





 





 





 



             $with_clause = "\n" . 'WITH ' . ($recursive ? 'RECURSIVE ' : $EMPTY_STR) . (join q{, }, @with_list); 




1587




 





 





 





 





 





 



         } 




1588




 





 





 





 





 





 



     } 




1589




 





 





 





 





 





 



     my $query_expression_body = $builder->build_query_query_expr_body( $view_node ); 




1590




 





 





 





 





 





 



     return $with_clause . $query_expression_body; 




1591




 





 





 





 





 





 



     # TODO: SQL:2003, 7.14 "" (p365). 




1592




 





 





 





 





 





 



 } 




1593




 





 





 





 





 





 



   




1594




 





 





 





 





 





 



 ###################################################################### 




1595




 





 





 





 





 





 



   




1596




 





 





 





 





 





 



 sub build_query_query_expr_body { # SQL:2003, 7.13 "" (p351) 




1597




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1598




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_query_expr_body', 




1599




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1600




 





 





 





 





 





 



     if ($view_node->get_attribute( 'view_type' ) eq 'COMPOUND') { 




1601




 





 





 





 





 





 



         # Result is multiple "SELECT ..." connected by one or more compound operators. 




1602




 





 





 





 





 





 



         my $compound_op = $view_node->get_attribute( 'compound_op' ); 




1603




 





 





 





 





 





 



         my $set_quantifier = $view_node->get_attribute( 'distinct_rows' ) ? 'DISTINCT' : 'ALL'; 




1604




 





 





 





 





 





 



         my @operand_list = (); 




1605




 





 





 





 





 





 



         for my $elem_node (@{$view_node->get_child_nodes( 'view_compound_elem' )}) { 




1606




 





 





 





 





 





 



             my $view_src_node = $elem_node->get_attribute( 'operand' ); 




1607




 





 





 





 





 





 



             my $match_node = $view_src_node->get_attribute( 'match' ); 




1608




 





 





 





 





 





 



             my $match_name = $builder->build_identifier_schema_or_app_obj( $match_node ); 




1609




 





 





 





 





 





 



             # Each compounding operand is assumed to have the same row data type as the view. 




1610




 





 





 





 





 





 



             if ($match_node->get_node_type() eq 'table') { 




1611




 





 





 





 





 





 



                 my $row_data_type_node = $builder->_row_data_type_of_node( $match_node ); 




1612




 





 





 





 





 





 



                 push @operand_list, join q{, } . "\n", 




1613




 





 





 





 





 





 



                     map { $builder->build_identifier_element( $_ ) } 




1614




 





 





 





 





 





 



                     @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}; 




1615




 





 





 





 





 





 



             } 




1616




 





 





 





 





 





 



             elsif ($match_node->get_node_type() eq 'view') { 




1617




 





 





 





 





 





 



                 push @operand_list, $builder->build_query_query_expr( $match_node ); 




1618




 





 





 





 





 





 



             } 




1619




 





 





 





 





 





 



             else { # the source node is a local variable of some kind 




1620




 





 





 





 





 





 



                 push @operand_list, $match_name; 




1621




 





 





 





 





 





 



             } 




1622




 





 





 





 





 





 



         } 




1623




 





 





 





 





 





 



         my $sql_operator 




1624




 





 





 





 





 





 



             = $compound_op eq 'UNION'        ? 'UNION' 




1625




 





 





 





 





 





 



             : $compound_op eq 'DIFFERENCE'   ? 'EXCEPT' 




1626




 





 





 





 





 





 



             : $compound_op eq 'INTERSECTION' ? 'INTERSECT' 




1627




 





 





 





 





 





 



             : $compound_op eq 'EXCLUSION'    ? 'EXCLUSION' # this 4th option not in SQL:2003. 




1628




 





 





 





 





 





 



             :                                  undef # we should never get here 




1629




 





 





 





 





 





 



             ; 




1630




 





 





 





 





 





 



             # TODO: try to emulate 'EXCLUSION' somewhere. 




1631




 





 





 





 





 





 



         return '(' . (join "\n" . $sql_operator . '_' . $set_quantifier, @operand_list) . ')'; 




1632




 





 





 





 





 





 



         # TODO: deal with engines that don't like "()" bounding compound operations. 




1633




 





 





 





 





 





 



         # TODO: possibly implement . 




1634




 





 





 





 





 





 



     } 




1635




 





 





 





 





 





 



     else { # view type ne 'COMPOUND' 




1636




 





 





 





 





 





 



         # Result is a single "SELECT ...", also known as a single "". 




1637




 





 





 





 





 





 



         return $builder->build_query_query_spec( $view_node ); 




1638




 





 





 





 





 





 



     } 




1639




 





 





 





 





 





 



 } 




1640




 





 





 





 





 





 



   




1641




 





 





 





 





 





 



 ###################################################################### 




1642




 





 





 





 





 





 



   




1643




 





 





 





 





 





 



 sub build_query_subquery { # SQL:2003, 7.15 "" (p370) 




1644




 





 





 





 





 





 



     my ($builder, $expr_node) = @_; 




1645




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_subquery', 




1646




 





 





 





 





 





 



         'EXPR_NODE', ['view_expr'], $expr_node ); 




1647




 





 





 





 





 





 



     my $cview = $expr_node->get_attribute( 'valf_call_view' ); 




1648




 





 





 





 





 





 



     if ($builder->{$PROP_INLINE_SUBQ}) { 




1649




 





 





 





 





 





 



         # Embed an anonymous subquery; argument passing is not yet supported. 




1650




 





 





 





 





 





 



         my $query_expression = $builder->build_query_query_expr( $cview ); 




1651




 





 





 





 





 





 



         return '(' . $query_expression . ')'; 




1652




 





 





 





 





 





 



     } 




1653




 





 





 





 





 





 



     else { 




1654




 





 





 





 





 





 



         # Call a named subquery; argument passing is supported. 




1655




 





 





 





 





 





 



         my $cview_name = $builder->build_identifier_schema_or_app_obj( $cview ); 




1656




 





 





 





 





 





 



         my %cview_arg_exprs 




1657




 





 





 





 





 





 



             = map { ($_->get_attribute( 'call_view_arg' )->get_self_id() => $_) } 




1658




 





 





 





 





 





 



               @{$expr_node->get_child_nodes()}; # gets child view_expr Nodes 




1659




 





 





 





 





 





 



         # Note: The build_expr() calls are done below to ensure the arg values are 




1660




 





 





 





 





 





 



         # defined in the same order they are output; this lets optional insertion 




1661




 





 





 





 





 





 



         # of positionally determined host params (and their mapping) to work right. 




1662




 





 





 





 





 





 



         my $arg_val_list = join q{, }, 




1663




 





 





 





 





 





 



             map { $cview_arg_exprs{$_->get_self_id()} 




1664




 





 





 





 





 





 



                   ? $builder->build_expr( $cview_arg_exprs{$_->get_self_id()} ) 




1665




 





 





 





 





 





 



                   : 'NULL' } 




1666




 





 





 





 





 





 



             @{$cview->get_child_nodes( 'view_arg' )}; 




1667




 





 





 





 





 





 



         return $cview_name . ($arg_val_list ? '(' . $arg_val_list . ')' : $EMPTY_STR); 




1668




 





 





 





 





 





 



     } 




1669




 





 





 





 





 





 



     # Note: Direct calls to schema object tables or views is not supported outside of 'FROM'. 




1670




 





 





 





 





 





 



 } 




1671




 





 





 





 





 





 



   




1672




 





 





 





 





 





 



 ###################################################################### 




1673




 





 





 





 





 





 



   




1674




 





 





 





 





 





 



 sub build_schema_create { # SQL:2003, 11.1 "" (p519) 




1675




 





 





 





 





 





 



     my ($builder, $schema_node) = @_; 




1676




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_create', 




1677




 





 





 





 





 





 



         'SCHEMA_NODE', ['schema'], $schema_node ); 




1678




 





 





 





 





 





 



     my $schema_name = $builder->build_identifier_element( $schema_node ); 




1679




 





 





 





 





 





 



     my $authorization = $EMPTY_STR; # TODO: AUTHORIZATION  




1680




 





 





 





 





 





 



     # Some other features in 11.1, such as default character set. 




1681




 





 





 





 





 





 



     return 'CREATE SCHEMA ' . $schema_name . ' ' . $authorization . ';' . "\n"; 




1682




 





 





 





 





 





 



 } 




1683




 





 





 





 





 





 



   




1684




 





 





 





 





 





 



 sub build_schema_delete { # SQL:2003, 11.2 "" (p522) 




1685




 





 





 





 





 





 



     my ($builder, $schema_node) = @_; 




1686




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_delete', 




1687




 





 





 





 





 





 



         'SCHEMA_NODE', ['schema'], $schema_node ); 




1688




 





 





 





 





 





 



     my $schema_name = $builder->build_identifier_element( $schema_node ); 




1689




 





 





 





 





 





 



     return 'DROP SCHEMA ' . $schema_name . ';' . "\n"; 




1690




 





 





 





 





 





 



 } 




1691




 





 





 





 





 





 



   




1692




 





 





 





 





 





 



 ###################################################################### 




1693




 





 





 





 





 





 



   




1694




 





 





 





 





 





 



 sub build_schema_or_app_scalar_domain_create { # SQL:2003, 11.24 "" (p603) 




1695




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1696




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_scalar_domain_create', 




1697




 





 





 





 





 





 



         'DOMAIN_NODE', ['scalar_domain'], $domain_node ); 




1698




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1699




 





 





 





 





 





 



     my $predefined_type = $builder->build_expr_scalar_data_type_defn( $domain_node ); 




1700




 





 





 





 





 





 



     # TODO: default clause, domain constraint, collate clause. 




1701




 





 





 





 





 





 



     my $is_temp = ($domain_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1702




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' DOMAIN ' . $domain_name . ' AS ' . $predefined_type . ';' . "\n"; 




1703




 





 





 





 





 





 



 } 




1704




 





 





 





 





 





 



   




1705




 





 





 





 





 





 



 sub build_schema_or_app_scalar_domain_delete { # SQL:2003, 11.30 "" (p610) 




1706




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1707




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_scalar_domain_delete', 




1708




 





 





 





 





 





 



         'DOMAIN_NODE', ['scalar_domain'], $domain_node ); 




1709




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1710




 





 





 





 





 





 



     return 'DROP DOMAIN ' . $domain_name . ';' . "\n"; 




1711




 





 





 





 





 





 



 } 




1712




 





 





 





 





 





 



   




1713




 





 





 





 





 





 



 ###################################################################### 




1714




 





 





 





 





 





 



   




1715




 





 





 





 





 





 



 sub build_schema_or_app_row_domain_create { # SQL:2003, 11.24 "" (p603) 




1716




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1717




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_row_domain_create', 




1718




 





 





 





 





 





 



         'DOMAIN_NODE', ['row_domain'], $domain_node ); 




1719




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1720




 





 





 





 





 





 



     my $predefined_type = $builder->build_expr_row_data_type_defn( $domain_node ); 




1721




 





 





 





 





 





 



     # TODO: default clause, domain constraint, collate clause. 




1722




 





 





 





 





 





 



     my $is_temp = ($domain_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1723




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' DOMAIN ' . $domain_name . ' AS ' . $predefined_type . ';' . "\n"; 




1724




 





 





 





 





 





 



 } 




1725




 





 





 





 





 





 



   




1726




 





 





 





 





 





 



 sub build_schema_or_app_row_domain_delete { # SQL:2003, 11.30 "" (p610) 




1727




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1728




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_row_domain_delete', 




1729




 





 





 





 





 





 



         'DOMAIN_NODE', ['row_domain'], $domain_node ); 




1730




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1731




 





 





 





 





 





 



     return 'DROP DOMAIN ' . $domain_name . ';' . "\n"; 




1732




 





 





 





 





 





 



 } 




1733




 





 





 





 





 





 



   




1734




 





 





 





 





 





 



 ###################################################################### 




1735




 





 





 





 





 





 



   




1736




 





 





 





 





 





 



 sub build_schema_or_app_sequence_create { # SQL:2003, 11.62 "" (p726) 




1737




 





 





 





 





 





 



     my ($builder, $sequence_node) = @_; 




1738




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_sequence_create', 




1739




 





 





 





 





 





 



         'SEQUENCE_NODE', ['sequence'], $sequence_node ); 




1740




 





 





 





 





 





 



     # SQL:2003 allows multiple data types for this, but we stick to integers for now. 




1741




 





 





 





 





 





 



     my $sequence_name = $builder->build_identifier_schema_or_app_obj( $sequence_node, 1 ); 




1742




 





 





 





 





 





 



     my $increment = $sequence_node->get_attribute( 'increment' ); 




1743




 





 





 





 





 





 



     my $min_val = $sequence_node->get_attribute( 'min_val' ); 




1744




 





 





 





 





 





 



     my $max_val = $sequence_node->get_attribute( 'max_val' ); 




1745




 





 





 





 





 





 



     my $start_val = $sequence_node->get_attribute( 'start_val' ); 




1746




 





 





 





 





 





 



     my $cycle = $sequence_node->get_attribute( 'cycle' ); 




1747




 





 





 





 





 





 



     my $order = $sequence_node->get_attribute( 'order' ); 




1748




 





 





 





 





 





 



     # Note that Rosetta::Model guarantees all integer attributes are already valid integers. 




1749




 





 





 





 





 





 



     my $is_temp = ($sequence_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1750




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' SEQUENCE ' . $sequence_name 




1751




 





 





 





 





 





 



         . (defined $increment ? ' INCREMENT BY ' . $increment : $EMPTY_STR) 




1752




 





 





 





 





 





 



         . (defined $start_val ? ' START WITH ' . $start_val : $EMPTY_STR) 




1753




 





 





 





 





 





 



         . (defined $min_val ? ' MINVALUE ' . $min_val : ' NO MINVALUE') 




1754




 





 





 





 





 





 



         . (defined $max_val ? ' MAXVALUE ' . $max_val : ' NO MAXVALUE') 




1755




 





 





 





 





 





 



         . ($cycle ? ' CYCLE' : ' NO CYCLE') 




1756




 





 





 





 





 





 



         . ($order ? ' ORDER' : ' NO ORDER') # standard doesn't mention this one 




1757




 





 





 





 





 





 



         . ';' . "\n"; 




1758




 





 





 





 





 





 



 } 




1759




 





 





 





 





 





 



   




1760




 





 





 





 





 





 



 sub build_schema_or_app_sequence_delete { # SQL:2003, 11.64 "" (p729) 




1761




 





 





 





 





 





 



     my ($builder, $sequence_node) = @_; 




1762




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_sequence_delete', 




1763




 





 





 





 





 





 



         'SEQUENCE_NODE', ['sequence'], $sequence_node ); 




1764




 





 





 





 





 





 



     my $sequence_name = $builder->build_identifier_schema_or_app_obj( $sequence_node, 1 ); 




1765




 





 





 





 





 





 



     return 'DROP SEQUENCE ' . $sequence_name . ';' . "\n"; 




1766




 





 





 





 





 





 



 } 




1767




 





 





 





 





 





 



   




1768




 





 





 





 





 





 



 ###################################################################### 




1769




 





 





 





 





 





 



   




1770




 





 





 





 





 





 



 sub build_schema_or_app_table_create { 




1771




 





 





 





 





 





 



     # SQL:2003, 6.2 "" (p173) 




1772




 





 





 





 





 





 



     # SQL:2003, 11.3 "" (p525) 




1773




 





 





 





 





 





 



     # SQL:2003, 11.4 "" (p536) 




1774




 





 





 





 





 





 



     # SQL:2003, 11.5 "" (p541) 




1775




 





 





 





 





 





 



     # SQL:2003, 11.6 "" (p545) 




1776




 





 





 





 





 





 



     # SQL:2003, 11.7 "" (p547) 




1777




 





 





 





 





 





 



     # SQL:2003, 11.8 "" (p549) 




1778




 





 





 





 





 





 



     # TODO: SQL:2003, 11.9 "" (p569) 




1779




 





 





 





 





 





 



     # TODO: "GENERATED ALWAYS AS ..." which looks like FileMaker's (etc) "calculation" field types. 




1780




 





 





 





 





 





 



     my ($builder, $table_node) = @_; 




1781




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_table_create', 




1782




 





 





 





 





 





 



         'TABLE_NODE', ['table'], $table_node ); 




1783




 





 





 





 





 





 



     my $table_name = $builder->build_identifier_schema_or_app_obj( $table_node, 1 ); 




1784




 





 





 





 





 





 



     my @table_field_sql = (); 




1785




 





 





 





 





 





 



     my %col_name_cache = (); # used when making ind defs 




1786




 





 





 





 





 





 



     my %mandatory_field_cache = (); # used when making ind defs 




1787




 





 





 





 





 





 



     my %table_fields_by_row_field = map { ($_->get_attribute( 'si_row_field' )->get_self_id() => $_) } 




1788




 





 





 





 





 





 



         @{$table_node->get_child_nodes( 'table_field' )}; 




1789




 





 





 





 





 





 



     my $row_data_type_node = $builder->_row_data_type_of_node( $table_node ); # is always set 




1790




 





 





 





 





 





 



     my $row_domain_node = $builder->_row_domain_of_node( $table_node ); # may be undefined 




1791




 





 





 





 





 





 



     for my $row_field_node (@{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}) { 




1792




 





 





 





 





 





 



         my $table_field_name = $builder->build_identifier_element( $row_field_node ); 




1793




 





 





 





 





 





 



         if (!exists $col_name_cache{$row_field_node->get_self_id()}) { 




1794




 





 





 





 





 





 



             $col_name_cache{$row_field_node->get_self_id()} = $table_field_name; 




1795




 





 





 





 





 





 



         } 




1796




 





 





 





 





 





 



         my $scalar_data_type_node = $row_field_node->get_attribute( 'scalar_data_type' ); 




1797




 





 





 





 





 





 



         my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( 




1798




 





 





 





 





 





 



             $row_domain_node ? $builder->find_scalar_domain_for_row_domain_field( 




1799




 





 





 





 





 





 



             $scalar_data_type_node, $row_domain_node ) : $scalar_data_type_node ); 




1800




 





 





 





 





 





 



         my $table_field_sql_item = $table_field_name . ' ' . $dt_or_dom_sql; 




1801




 





 





 





 





 





 



         if (my $table_field_node = $table_fields_by_row_field{$row_field_node->get_self_id()}) { 




1802




 





 





 





 





 





 



             my $mandatory = $table_field_node->get_attribute( 'mandatory' ); 




1803




 





 





 





 





 





 



             $mandatory and $mandatory_field_cache{$row_field_node->get_self_id()} = 1; 




1804




 





 





 





 





 





 



             my $default_val = $table_field_node->get_attribute( 'default_val' ); 




1805




 





 





 





 





 





 



             my $auto_inc = $table_field_node->get_attribute( 'auto_inc' ); 




1806




 





 





 





 





 





 



             my $default_seq_node = $table_field_node->get_attribute( 'default_seq' ); 




1807




 





 





 





 





 





 



             $table_field_sql_item .= ($mandatory ? ' NOT NULL' : ' NULL') 




1808




 





 





 





 





 





 



                 . (defined $default_val ? ' DEFAULT ' . $builder->quote_literal( 




1809




 





 





 





 





 





 



                     $default_val, $scalar_data_type_node->get_attribute( 'base_type' ) ) : $EMPTY_STR) 




1810




 





 





 





 





 





 



                 . ($auto_inc ? ' AUTO_INCREMENT' : $EMPTY_STR) 




1811




 





 





 





 





 





 



                 . ($default_seq_node ? ' DEFAULT ' 




1812




 





 





 





 





 





 



                     . $builder->build_expr_seq_next( $default_seq_node ) : $EMPTY_STR); 




1813




 





 





 





 





 





 



         } 




1814




 





 





 





 





 





 



         else { 




1815




 





 





 





 





 





 



             $table_field_sql_item .= ' NULL'; 




1816




 





 





 





 





 





 



         } 




1817




 





 





 





 





 





 



         push @table_field_sql, $table_field_sql_item; 




1818




 





 





 





 





 





 



     } 




1819




 





 





 





 





 





 



     my @table_index_sql = (); 




1820




 





 





 





 





 





 



     my $pk_is_made = 0; 




1821




 





 





 





 





 





 



     for my $table_index_node (@{$table_node->get_child_nodes( 'table_index' )}) { 




1822




 





 





 





 





 





 



         my $table_index_name = $builder->build_identifier_element( $table_index_node ); 




1823




 





 





 





 





 





 



         my $index_type = $table_index_node->get_attribute( 'index_type' ); 




1824




 





 





 





 





 





 



         my @table_index_field_nodes = @{$table_index_node->get_child_nodes( 'table_index_field' )}; 




1825




 





 





 





 





 





 



         my $local_field_names_sql = join q{, }, map { 




1826




 





 





 





 





 





 



                 $col_name_cache{$_->get_attribute( 'si_field' )->get_self_id()} 




1827




 





 





 





 





 





 



             } @table_index_field_nodes; 




1828




 





 





 





 





 





 



         if ($index_type eq 'ATOMIC') { 




1829




 





 





 





 





 





 



             push @table_index_sql, 'INDEX ' . $table_index_name . ' (' . $local_field_names_sql . ')'; 




1830




 





 





 





 





 





 



         } 




1831




 





 





 





 





 





 



         if ($index_type eq 'FULLTEXT') { 




1832




 





 





 





 





 





 



             push @table_index_sql, 'FULLTEXT INDEX ' . $table_index_name . ' (' . $local_field_names_sql . ')'; 




1833




 





 





 





 





 





 



         } 




1834




 





 





 





 





 





 



         if ($index_type eq 'UNIQUE' or $index_type eq 'UFOREIGN') { 




1835




 





 





 





 





 





 



             my $make_a_pk_now = 0; 




1836




 





 





 





 





 





 



             if (!$pk_is_made) { 




1837




 





 





 





 





 





 



                 # All component columns of a primary key must be mandatory; check for it. 




1838




 





 





 





 





 





 



                 $make_a_pk_now = all { 




1839




 





 





 





 





 





 



                         $mandatory_field_cache{ $_->get_attribute( 'si_field' )->get_self_id() } 




1840




 





 





 





 





 





 



                     } @table_index_field_nodes; 




1841




 





 





 





 





 





 



             } 




1842




 





 





 





 





 





 



             if ($make_a_pk_now) { 




1843




 





 





 





 





 





 



                 push @table_index_sql, 'CONSTRAINT PRIMARY KEY (' . $local_field_names_sql . ')'; 




1844




 





 





 





 





 





 



             } 




1845




 





 





 





 





 





 



             else { 




1846




 





 





 





 





 





 



                 push @table_index_sql, 'CONSTRAINT ' . $table_index_name . ' UNIQUE' 




1847




 





 





 





 





 





 



                     . ' (' . $local_field_names_sql . ')'; # standard does not say INDEX after UNIQUE 




1848




 





 





 





 





 





 



             } 




1849




 





 





 





 





 





 



         } 




1850




 





 





 





 





 





 



         if ($index_type eq 'FOREIGN' or $index_type eq 'UFOREIGN') { 




1851




 





 





 





 





 





 



             my $foreign_table_name = $builder->build_identifier_schema_or_app_obj( 




1852




 





 





 





 





 





 



                 $table_index_node->get_attribute( 'f_table' ) ); 




1853




 





 





 





 





 





 



             my $foreign_field_names_sql = join q{, }, map { 




1854




 





 





 





 





 





 



                     $builder->build_identifier_element( $_->get_attribute( 'f_field' ) ) 




1855




 





 





 





 





 





 



                 } @table_index_field_nodes; 




1856




 





 





 





 





 





 



             push @table_index_sql, 'CONSTRAINT ' . $table_index_name . ' FOREIGN KEY' 




1857




 





 





 





 





 





 



                 . ' (' . $local_field_names_sql . ') REFERENCES ' . $foreign_table_name 




1858




 





 





 





 





 





 



                 . ' (' . $foreign_field_names_sql . ')'; 




1859




 





 





 





 





 





 



         } 




1860




 





 





 





 





 





 



     } 




1861




 





 





 





 





 





 



     my $is_temp = ($table_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1862




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' TABLE ' . $table_name 




1863




 





 





 





 





 





 



            . ' (' . "\n" . (join q{, } . "\n", @table_field_sql, @table_index_sql) . "\n" . ');' . "\n"; 




1864




 





 





 





 





 





 



 } 




1865




 





 





 





 





 





 



   




1866




 





 





 





 





 





 



 sub build_schema_or_app_table_delete { # SQL:2003, 11.21 "" (p587) 




1867




 





 





 





 





 





 



     my ($builder, $table_node) = @_; 




1868




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_table_delete', 




1869




 





 





 





 





 





 



         'TABLE_NODE', ['table'], $table_node ); 




1870




 





 





 





 





 





 



     my $table_name = $builder->build_identifier_schema_or_app_obj( $table_node, 1 ); 




1871




 





 





 





 





 





 



     return 'DROP TABLE ' . $table_name . ';' . "\n"; 




1872




 





 





 





 





 





 



 } 




1873




 





 





 





 





 





 



   




1874




 





 





 





 





 





 



 ###################################################################### 




1875




 





 





 





 





 





 



   




1876




 





 





 





 





 





 



 sub build_schema_or_app_view_create { # SQL:2003, 11.22 "" (p590) 




1877




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1878




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_view_create', 




1879




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1880




 





 





 





 





 





 



     my $view_name = $builder->build_identifier_schema_or_app_obj( $view_node, 1 ); 




1881




 





 





 





 





 





 



     my $query_expression = $builder->build_query_query_expr( $view_node ); 




1882




 





 





 





 





 





 



     my $is_temp = ($view_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1883




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' VIEW ' . $view_name . ' AS ' . $query_expression . ';' . "\n"; 




1884




 





 





 





 





 





 



     # Note: Several interesting looking features are not implemented yet. 




1885




 





 





 





 





 





 



 } 




1886




 





 





 





 





 





 



   




1887




 





 





 





 





 





 



 sub build_schema_or_app_view_delete { # SQL:2003, 11.23 "" (p600) 




1888




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1889




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_view_delete', 




1890




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1891




 





 





 





 





 





 



     my $view_name = $builder->build_identifier_schema_or_app_obj( $view_node, 1 ); 




1892




 





 





 





 





 





 



     return 'DROP VIEW ' . $view_name . ';' . "\n"; 




1893




 





 





 





 





 





 



 } 




1894




 





 





 





 





 





 



   




1895




 





 





 





 





 





 



 ###################################################################### 




1896




 





 





 





 





 





 



   




1897




 





 





 





 





 





 



 sub build_schema_or_app_routine_create { 




1898




 





 





 





 





 





 



     # SQL:2003, 11.39 "" (p629) 




1899




 





 





 





 





 





 



     # SQL:2003, 11.50 "" (p675) 




1900




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




1901




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_routine_create', 




1902




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




1903




 





 





 





 





 





 



     my $routine_type = $routine_node->get_attribute( 'routine_type' ); 




1904




 





 





 





 





 





 



     my $routine_name = $builder->build_identifier_schema_or_app_obj( $routine_node, 1 ); 




1905




 





 





 





 





 





 



     my $is_temp = ($routine_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1906




 





 





 





 





 





 



     if ($routine_type eq 'PACKAGE') { 




1907




 





 





 





 





 





 



         # Not implemented yet. 




1908




 





 





 





 





 





 



     } 




1909




 





 





 





 





 





 



     elsif ($routine_type eq 'TRIGGER') { 




1910




 





 





 





 





 





 



         my $table_or_view_name = $builder->build_identifier_schema_or_app_obj( 




1911




 





 





 





 





 





 



             $routine_node->get_attribute( 'trigger_on' ) ); 




1912




 





 





 





 





 





 



         my $trigger_event = $routine_node->get_attribute( 'trigger_event' ); 




1913




 





 





 





 





 





 



         my $trigger_event_sql 




1914




 





 





 





 





 





 



             = $trigger_event eq 'BEFR_INS' ? 'BEFORE INSERT' 




1915




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_INS' ? 'AFTER INSERT' 




1916




 





 





 





 





 





 



             : $trigger_event eq 'INST_INS' ? 'INSTEAD OF INSERT' 




1917




 





 





 





 





 





 



             : $trigger_event eq 'BEFR_UPD' ? 'BEFORE UPDATE' 




1918




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_UPD' ? 'AFTER UPDATE' 




1919




 





 





 





 





 





 



             : $trigger_event eq 'INST_UPD' ? 'INSTEAD OF UPDATE' 




1920




 





 





 





 





 





 



             : $trigger_event eq 'BEFR_DEL' ? 'BEFORE DELETE' 




1921




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_DEL' ? 'AFTER DELETE' 




1922




 





 





 





 





 





 



             : $trigger_event eq 'INST_DEL' ? 'INSTEAD OF DELETE' 




1923




 





 





 





 





 





 



             :                                undef # we should never get here 




1924




 





 





 





 





 





 



             ; 




1925




 





 





 





 





 





 



             # Note: INSTEAD OF is not standard SQL, but supported by SQLServer 2000, maybe Oracle, ?. 




1926




 





 





 





 





 





 



         my $for_each_stmt = $routine_node->get_attribute( 'trigger_per_stmt' ); 




1927




 





 





 





 





 





 



         # TODO: Implement optional OF . 




1928




 





 





 





 





 





 



         my @transition_var_names = (); # TODO: NEW/OLD ROW AS <... variable name> 




1929




 





 





 





 





 





 



         my $triggered_sql_statement = $builder->build_dmanip_routine_body( $routine_node, 1 ); 




1930




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' TRIGGER ' . $routine_name . ' ' 




1931




 





 





 





 





 





 



             . $trigger_event_sql . ' ON ' . $table_or_view_name 




1932




 





 





 





 





 





 



             . (@transition_var_names ? ' REFERENCING ' . (join ' ', @transition_var_names) : $EMPTY_STR) 




1933




 





 





 





 





 





 



             . ($for_each_stmt ? ' FOR EACH STATEMENT' : ' FOR EACH ROW') 




1934




 





 





 





 





 





 



             # TODO: WHEN (  ) 




1935




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1936




 





 





 





 





 





 



             . $triggered_sql_statement 




1937




 





 





 





 





 





 



             . ';' . "\n"; 




1938




 





 





 





 





 





 



     } 




1939




 





 





 





 





 





 



     elsif ($routine_type eq 'PROCEDURE') { 




1940




 





 





 





 





 





 



         my $routine_args = $builder->build_dmanip_routine_args( $routine_node ); 




1941




 





 





 





 





 





 



         # TODO:  where appropriate. 




1942




 





 





 





 





 





 



         my $routine_body = $builder->build_dmanip_routine_body( $routine_node ); 




1943




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' PROCEDURE ' . $routine_name 




1944




 





 





 





 





 





 



             . $routine_args 




1945




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1946




 





 





 





 





 





 



             . ' ' . $routine_body . ';' . "\n"; 




1947




 





 





 





 





 





 



     } 




1948




 





 





 





 





 





 



     elsif ($routine_type eq 'FUNCTION') { 




1949




 





 





 





 





 





 



         my $routine_args = $builder->build_dmanip_routine_args( $routine_node ); 




1950




 





 





 





 





 





 



         # TODO:  where appropriate. 




1951




 





 





 





 





 





 



         my $routine_body = $builder->build_dmanip_routine_body( $routine_node ); 




1952




 





 





 





 





 





 



         my $return_cont_type = $routine_node->get_attribute( 'return_cont_type' ); 




1953




 





 





 





 





 





 



         my $return_data_type = $EMPTY_STR; 




1954




 





 





 





 





 





 



         if ($return_cont_type eq 'ERROR') { 




1955




 





 





 





 





 





 



             # Not implemented yet. 




1956




 





 





 





 





 





 



         } 




1957




 





 





 





 





 





 



         elsif ($return_cont_type eq 'SCALAR') { 




1958




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_scalar_data_type' ); 




1959




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




1960




 





 





 





 





 





 



         } 




1961




 





 





 





 





 





 



         elsif ($return_cont_type eq 'ROW') { 




1962




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_row_data_type' ); 




1963




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




1964




 





 





 





 





 





 



         } 




1965




 





 





 





 





 





 



         elsif ($return_cont_type eq 'SC_ARY') { 




1966




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_scalar_data_type' ); 




1967




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ) . ' ARRAY'; 




1968




 





 





 





 





 





 



         } 




1969




 





 





 





 





 





 



         elsif ($return_cont_type eq 'RW_ARY') { 




1970




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_row_data_type' ); 




1971




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ) . ' ARRAY'; 




1972




 





 





 





 





 





 



         } 




1973




 





 





 





 





 





 



         elsif ($return_cont_type eq 'CONN') { 




1974




 





 





 





 





 





 



             # Not implemented yet. 




1975




 





 





 





 





 





 



         } 




1976




 





 





 





 





 





 



         elsif ($return_cont_type eq 'CURSOR') { 




1977




 





 





 





 





 





 



             # Not implemented yet. 




1978




 





 





 





 





 





 



         } 




1979




 





 





 





 





 





 



         elsif ($return_cont_type eq 'LIST') { 




1980




 





 





 





 





 





 



             # Not implemented yet. 




1981




 





 





 





 





 





 



         } 




1982




 





 





 





 





 





 



         else {} 




1983




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' FUNCTION ' . $routine_name 




1984




 





 





 





 





 





 



             . $routine_args 




1985




 





 





 





 





 





 



             . ' RETURNS ' . $return_data_type 




1986




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1987




 





 





 





 





 





 



             . ' ' . $routine_body . ';' . "\n"; 




1988




 





 





 





 





 





 



     } 




1989




 





 





 





 





 





 



     else {} # $routine_type eq 'BLOCK' 




1990




 





 





 





 





 





 



         # 'BLOCK': no-op; you should call build_dmanip_routine_body() directly instead 




1991




 





 





 





 





 





 



 } 




1992




 





 





 





 





 





 



   




1993




 





 





 





 





 





 



 sub build_schema_or_app_routine_delete { 




1994




 





 





 





 





 





 



     # SQL:2003, 11.40 "" (p633) 




1995




 





 





 





 





 





 



     # SQL:2003, 11.52 "" (p703) 




1996




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




1997




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_routine_delete', 




1998




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




1999




 





 





 





 





 





 



     my $routine_type = $routine_node->get_attribute( 'routine_type' ); 




2000




 





 





 





 





 





 



     my $routine_name = $builder->build_identifier_schema_or_app_obj( $routine_node, 1 ); 




2001




 





 





 





 





 





 



     # Note: 10.6 "" (p499) may be useful later. 




2002




 





 





 





 





 





 



     if ($routine_type eq 'PACKAGE') { 




2003




 





 





 





 





 





 



         # Not implemented yet. 




2004




 





 





 





 





 





 



     } 




2005




 





 





 





 





 





 



     elsif ($routine_type eq 'TRIGGER') { 




2006




 





 





 





 





 





 



         return 'DROP TRIGGER ' . $routine_name . ';' . "\n"; 




2007




 





 





 





 





 





 



     } 




2008




 





 





 





 





 





 



     elsif ($routine_type eq 'PROCEDURE') { 




2009




 





 





 





 





 





 



         return 'DROP PROCEDURE ' . $routine_name . ';' . "\n"; 




2010




 





 





 





 





 





 



     } 




2011




 





 





 





 





 





 



     elsif ($routine_type eq 'FUNCTION') { 




2012




 





 





 





 





 





 



         return 'DROP FUNCTION ' . $routine_name . ';' . "\n"; 




2013




 





 





 





 





 





 



     } 




2014




 





 





 





 





 





 



     else {} # $routine_type eq 'BLOCK'; no-op 




2015




 





 





 





 





 





 



 } 




2016




 





 





 





 





 





 



   




2017




 





 





 





 





 





 



 ###################################################################### 




2018




 





 





 





 





 





 



   




2019




 





 





 





 





 





 



 sub build_access_role_create { # SQL:2003, 12.4 "" (p743) 




2020




 





 





 





 





 





 



     my ($builder, $role_node) = @_; 




2021




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_role_create', 




2022




 





 





 





 





 





 



         'ROLE_NODE', ['role'], $role_node ); 




2023




 





 





 





 





 





 



     my $role_name = $builder->build_identifier_element( $role_node ); 




2024




 





 





 





 





 





 



     return 'CREATE ROLE ' . $role_name . ';' . "\n"; 




2025




 





 





 





 





 





 



 } 




2026




 





 





 





 





 





 



   




2027




 





 





 





 





 





 



 sub build_access_role_delete { # SQL:2003, 12.6 "" (p746) 




2028




 





 





 





 





 





 



     my ($builder, $role_node) = @_; 




2029




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_role_delete', 




2030




 





 





 





 





 





 



         'ROLE_NODE', ['role'], $role_node ); 




2031




 





 





 





 





 





 



     my $role_name = $builder->build_identifier_element( $role_node ); 




2032




 





 





 





 





 





 



     return 'DROP ROLE ' . $role_name . ';' . "\n"; 




2033




 





 





 





 





 





 



 } 




2034




 





 





 





 





 





 



   




2035




 





 





 





 





 





 



 ###################################################################### 




2036




 





 





 





 





 





 



   




2037




 





 





 





 





 





 



 sub build_access_grant { 




2038




 





 





 





 





 





 



     # Function returns empty string if given grantee has no privileges. 




2039




 





 





 





 





 





 



     # SQL:2003, 12.1 "" (p731) 




2040




 





 





 





 





 





 



     # SQL:2003, 12.2 "" (p736) 




2041




 





 





 





 





 





 



     # SQL:2003, 12.3 "" (p739) 




2042




 





 





 





 





 





 



     # SQL:2003, 12.5 "" (p744) 




2043




 





 





 





 





 





 



     my ($builder, $grantee_node) = @_; 




2044




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_grant', 




2045




 





 





 





 





 





 



         'GRANTEE_NODE', ['role','user'], $grantee_node ); 




2046




 





 





 





 





 





 



     my $node_type = $grantee_node->get_node_type(); 




2047




 





 





 





 





 





 



     my $grantee_name = $builder->build_identifier_schema_or_app_obj( $grantee_node ); 




2048




 





 





 





 





 





 



     if ($node_type eq 'role') { 




2049




 





 





 





 





 





 



         my @grant_stmts = (); 




2050




 





 





 





 





 





 



         for my $priv_on_node (@{$grantee_node->get_child_nodes( 'privilege_on' )}) { 




2051




 





 





 





 





 





 



             my $object_node = $priv_on_node->get_attribute( 'si_priv_on' ); 




2052




 





 





 





 





 





 



             my $object_name = $builder->build_identifier_schema_or_app_obj( $object_node ); 




2053




 





 





 





 





 





 



             my @priv_types = map { $_->get_attribute( 'si_priv_type' ) } 




2054




 





 





 





 





 





 



                 @{$priv_on_node->get_child_nodes( 'privilege_for' )}; 




2055




 





 





 





 





 





 



             my @object_privs = (); 




2056




 





 





 





 





 





 



             if (grep { $_ eq 'ALL' } @priv_types) { 




2057




 





 





 





 





 





 



                 push @object_privs, 'ALL PRIVILEGES'; 




2058




 





 





 





 





 





 



             } 




2059




 





 





 





 





 





 



             else { 




2060




 





 





 





 





 





 



                 for my $priv_type (@priv_types) { 




2061




 





 





 





 





 





 



                     push @object_privs, 




2062




 





 





 





 





 





 



                            $priv_type eq 'SELECT' ? 'SELECT' # TODO: allow only specific columns 




2063




 





 





 





 





 





 



                          : $priv_type eq 'DELETE' ? 'DELETE' 




2064




 





 





 





 





 





 



                          : $priv_type eq 'INSERT' ? 'INSERT' # TODO: allow only specific columns 




2065




 





 





 





 





 





 



                          : $priv_type eq 'UPDATE' ? 'UPDATE' # TODO: allow only specific columns 




2066




 





 





 





 





 





 



                          :                          $EMPTY_STR # TODO: REFERENCES, USAGE, TRIGGER, UNDER, EXECUTE; what do they mean? 




2067




 





 





 





 





 





 



                          ; 




2068




 





 





 





 





 





 



                 } 




2069




 





 





 





 





 





 



             } 




2070




 





 





 





 





 





 



             push @grant_stmts, 'GRANT ' . (join q{, }, @object_privs) 




2071




 





 





 





 





 





 



                 . ' ON ' . $object_name . ' TO ' . $grantee_name . ';'; 




2072




 





 





 





 





 





 



         } 




2073




 





 





 





 





 





 



         return join $EMPTY_STR, @grant_stmts; 




2074




 





 





 





 





 





 



     } 




2075




 





 





 





 





 





 



     elsif ($node_type eq 'user') { 




2076




 





 





 





 





 





 



         my @role_names = map { $builder->build_identifier_schema_or_app_obj( $_ ) } 




2077




 





 





 





 





 





 



             @{$grantee_node->get_child_nodes( 'user_role' )}; 




2078




 





 





 





 





 





 



         return @role_names ? 'GRANT ' . (join q{, }, @role_names) . ' TO ' . $grantee_name . ';' : $EMPTY_STR; 




2079




 





 





 





 





 





 



     } 




2080




 





 





 





 





 





 



     else {} 




2081




 





 





 





 





 





 



 } 




2082




 





 





 





 





 





 



   




2083




 





 





 





 





 





 



 sub build_access_revoke { 




2084




 





 





 





 





 





 



     # SQL:2003, 12.7 "" (p747) 




2085




 





 





 





 





 





 



     # SQL:2003, 12.3 "" (p739) 




2086




 





 





 





 





 





 



     my ($builder, $grantee_node) = @_; 




2087




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_revoke', 




2088




 





 





 





 





 





 



         'GRANTEE_NODE', ['role','user'], $grantee_node ); 




2089




 





 





 





 





 





 



     my $node_type = $grantee_node->get_node_type(); 




2090




 





 





 





 





 





 



     my $grantee_name = $builder->build_identifier_schema_or_app_obj( $grantee_node ); 




2091




 





 





 





 





 





 



     if ($node_type eq 'role') { 




2092




 





 





 





 





 





 



         my @revoke_stmts = (); 




2093




 





 





 





 





 





 



         for my $priv_on_node (@{$grantee_node->get_child_nodes( 'privilege_on' )}) { 




2094




 





 





 





 





 





 



             my $object_node = $priv_on_node->get_attribute( 'si_priv_on' ); 




2095




 





 





 





 





 





 



             my $object_name = $builder->build_identifier_schema_or_app_obj( $object_node ); 




2096




 





 





 





 





 





 



             push @revoke_stmts, 'REVOKE ALL PRIVILEGES' 




2097




 





 





 





 





 





 



                 . ' ON ' . $object_name . ' FROM ' . $grantee_name . ';'; 




2098




 





 





 





 





 





 



         } 




2099




 





 





 





 





 





 



         return join $EMPTY_STR, @revoke_stmts; 




2100




 





 





 





 





 





 



     } 




2101




 





 





 





 





 





 



     elsif ($node_type eq 'user') { 




2102




 





 





 





 





 





 



         my @role_names = map { $builder->build_identifier_schema_or_app_obj( $_ ) } 




2103




 





 





 





 





 





 



             @{$grantee_node->get_child_nodes( 'user_role' )}; 




2104




 





 





 





 





 





 



         return @role_names ? 'REVOKE ' . (join q{, }, @role_names) . ' FROM ' . $grantee_name . ';' : $EMPTY_STR; 




2105




 





 





 





 





 





 



     } 




2106




 





 





 





 





 





 



     else {} 




2107




 





 





 





 





 





 



 } 




2108




 





 





 





 





 





 



   




2109




 





 





 





 





 





 



 ###################################################################### 




2110




 





 





 





 





 





 



   




2111




 





 





 





 





 





 



 sub build_dmanip_routine_args { 




2112




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




2113




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_args', 




2114




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




2115




 





 





 





 





 





 



     # SQL:2003, 11.50 "" (p675) 




2116




 





 





 





 





 





 



     # in particular see  




2117




 





 





 





 





 





 



     my @rtn_arg_declare_sql = (); 




2118




 





 





 





 





 





 



     for my $rtn_arg_node (@{$routine_node->get_child_nodes( 'routine_arg' )}) { 




2119




 





 





 





 





 





 



         # TODO:  ::= IN | OUT | INOUT 




2120




 





 





 





 





 





 



         my $arg_name = $builder->build_identifier_element( $rtn_arg_node ); 




2121




 





 





 





 





 





 



         my $cont_type = $rtn_arg_node->get_attribute( 'cont_type' ); 




2122




 





 





 





 





 





 



         if ($cont_type eq 'ERROR') { 




2123




 





 





 





 





 





 



             # Not implemented yet. 




2124




 





 





 





 





 





 



         } 




2125




 





 





 





 





 





 



         elsif ($cont_type eq 'SCALAR') { 




2126




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'scalar_data_type' ); 




2127




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2128




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ';'; 




2129




 





 





 





 





 





 



         } 




2130




 





 





 





 





 





 



         elsif ($cont_type eq 'ROW') { 




2131




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'row_data_type' ); 




2132




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2133




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ';'; 




2134




 





 





 





 





 





 



         } 




2135




 





 





 





 





 





 



         elsif ($cont_type eq 'SC_ARY') { 




2136




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'scalar_data_type' ); 




2137




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2138




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2139




 





 





 





 





 





 



         } 




2140




 





 





 





 





 





 



         elsif ($cont_type eq 'RW_ARY') { 




2141




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'row_data_type' ); 




2142




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2143




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2144




 





 





 





 





 





 



         } 




2145




 





 





 





 





 





 



         elsif ($cont_type eq 'CONN') { 




2146




 





 





 





 





 





 



             # Not implemented yet. 




2147




 





 





 





 





 





 



         } 




2148




 





 





 





 





 





 



         elsif ($cont_type eq 'CURSOR') { 




2149




 





 





 





 





 





 



             # Not implemented yet. 




2150




 





 





 





 





 





 



         } 




2151




 





 





 





 





 





 



         elsif ($cont_type eq 'LIST') { 




2152




 





 





 





 





 





 



             # Not implemented yet. 




2153




 





 





 





 





 





 



         } 




2154




 





 





 





 





 





 



         else {} 




2155




 





 





 





 





 





 



     } 




2156




 





 





 





 





 





 



     return @rtn_arg_declare_sql ? '(' . (join q{, }, @rtn_arg_declare_sql) . ')' : $EMPTY_STR; 




2157




 





 





 





 





 





 



 } 




2158




 





 





 





 





 





 



   




2159




 





 





 





 





 





 



 sub build_dmanip_routine_body { 




2160




 





 





 





 





 





 



     # Corresponds to these sections: 




2161




 





 





 





 





 





 



     # ? 




2162




 





 





 





 





 





 



     # SQL:2003, 6.1 "" (p161) 




2163




 





 





 





 





 





 



     # SQL:2003, 13.5 "" (p790) 




2164




 





 





 





 





 





 



     # SQL:2003, 14.1 "" (p809) 




2165




 





 





 





 





 





 



     my ($builder, $routine_node, $is_atomic) = @_; 




2166




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_body', 




2167




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




2168




 





 





 





 





 





 



     my $is_ora_routines = $builder->{$PROP_ORA_ROUTINES}; 




2169




 





 





 





 





 





 



     my @rtn_var_declare_sql = (); 




2170




 





 





 





 





 





 



     for my $rtn_var_node (@{$routine_node->get_child_nodes( 'routine_var' )}) { 




2171




 





 





 





 





 





 



         my $var_name = $builder->build_identifier_element( $rtn_var_node ); 




2172




 





 





 





 





 





 



         my $cont_type = $rtn_var_node->get_attribute( 'cont_type' ); 




2173




 





 





 





 





 





 



         if ($cont_type eq 'ERROR') { 




2174




 





 





 





 





 





 



             # Not implemented yet. 




2175




 





 





 





 





 





 



         } 




2176




 





 





 





 





 





 



         elsif ($cont_type eq 'SCALAR') { 




2177




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'scalar_data_type' ); 




2178




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2179




 





 





 





 





 





 



             my $init_lit_val = $rtn_var_node->get_attribute( 'init_lit_val' ); 




2180




 





 





 





 





 





 



             my $is_constant = $rtn_var_node->get_attribute( 'is_constant' ); 




2181




 





 





 





 





 





 



             push @rtn_var_declare_sql, 




2182




 





 





 





 





 





 



                 ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') 




2183




 





 





 





 





 





 



                 . $var_name . ' ' . $dt_or_dom_sql 




2184




 





 





 





 





 





 



                 # TODO: use $is_constant 




2185




 





 





 





 





 





 



                 . (defined $init_lit_val ? ' DEFAULT ' . $builder->quote_literal( $init_lit_val, 




2186




 





 





 





 





 





 



                     $builder->_scalar_data_type_of_node( $rtn_var_node )->get_attribute( 'base_type' ) ) : $EMPTY_STR) 




2187




 





 





 





 





 





 



                 . ';' 




2188




 





 





 





 





 





 



             ; 




2189




 





 





 





 





 





 



         } 




2190




 





 





 





 





 





 



         elsif ($cont_type eq 'ROW') { 




2191




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'row_data_type' ); 




2192




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2193




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ';'; 




2194




 





 





 





 





 





 



         } 




2195




 





 





 





 





 





 



         elsif ($cont_type eq 'SC_ARY') { 




2196




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'scalar_data_type' ); 




2197




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2198




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2199




 





 





 





 





 





 



         } 




2200




 





 





 





 





 





 



         elsif ($cont_type eq 'RW_ARY') { 




2201




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'row_data_type' ); 




2202




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2203




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2204




 





 





 





 





 





 



         } 




2205




 





 





 





 





 





 



         elsif ($cont_type eq 'CONN') { 




2206




 





 





 





 





 





 



             # Not implemented yet. 




2207




 





 





 





 





 





 



         } 




2208




 





 





 





 





 





 



         elsif ($cont_type eq 'CURSOR') { 




2209




 





 





 





 





 





 



             if (my $view_node = (@{$rtn_var_node->get_child_nodes( 'view' )})[0]) { 




2210




 





 





 





 





 





 



                 # Since we got here, cursor will be defined within curr rtn, regardless of share or not. 




2211




 





 





 





 





 





 



                 my $query_expr = $builder->build_query_query_expr( $view_node ); 




2212




 





 





 





 





 





 



                 my $order_by_clause = $builder->build_query_window_clause( $view_node ); 




2213




 





 





 





 





 





 



                 my $updatability_clause 




2214




 





 





 





 





 





 



                     = $rtn_var_node->get_attribute( 'curs_for_update' ) ? 'FOR UPDATE' 




2215




 





 





 





 





 





 



                     :                                                     'FOR READ ONLY'; # TODO: [ OF  ] 




2216




 





 





 





 





 





 



                 # TODO: sensitivity, scrollability, holdability, returnability 




2217




 





 





 





 





 





 



                 my $cursor_spec = $query_expr . ' ' . $order_by_clause . ' ' . $updatability_clause; 




2218




 





 





 





 





 





 



                 push @rtn_var_declare_sql, 'DECLARE ' . $var_name . ' CURSOR FOR ' . $cursor_spec . ';'; 




2219




 





 





 





 





 





 



             } 




2220




 





 





 





 





 





 



             else { 




2221




 





 





 





 





 





 



                 # Not implemented yet; but also not sure of proper way to implement. 




2222




 





 





 





 





 





 



                 # If we got here then cursor had been declared in diff rtn and passed to curr one. 




2223




 





 





 





 





 





 



                 # We can't just make another copy of decl since may use vars/args/etc of other rtn. 




2224




 





 





 





 





 





 



                 push @rtn_var_declare_sql, 'DECLARE ' . $var_name . ';'; 




2225




 





 





 





 





 





 



             } 




2226




 





 





 





 





 





 



         } 




2227




 





 





 





 





 





 



         elsif ($cont_type eq 'LIST') { 




2228




 





 





 





 





 





 



             # Not implemented yet. 




2229




 





 





 





 





 





 



         } 




2230




 





 





 





 





 





 



         else {} 




2231




 





 





 





 





 





 



     } 




2232




 





 





 





 





 





 



     my @rtn_stmt_sql = (); 




2233




 





 





 





 





 





 



     for my $rtn_stmt_node (@{$routine_node->get_child_nodes( 'routine_stmt' )}) { 




2234




 





 





 





 





 





 



         push @rtn_stmt_sql, $builder->build_dmanip_routine_stmt( $rtn_stmt_node ); 




2235




 





 





 





 





 





 



     } 




2236




 





 





 





 





 





 



     my $atomic_clause = $is_atomic ? 'ATOMIC ' : $EMPTY_STR; 




2237




 





 





 





 





 





 



     return join ' ', 




2238




 





 





 





 





 





 



         # TODO: proper handling of vars declared within 'BLOCK' routines, when in Oracle syntax. 




2239




 





 





 





 





 





 



         ($is_ora_routines ? 'VAR ' : 'BEGIN ' . $atomic_clause), 




2240




 





 





 





 





 





 



         @rtn_var_declare_sql, 




2241




 





 





 





 





 





 



         ($is_ora_routines ? 'BEGIN ' . $atomic_clause : $EMPTY_STR), 




2242




 





 





 





 





 





 



         @rtn_stmt_sql, 




2243




 





 





 





 





 





 



         'END;' 




2244




 





 





 





 





 





 



     ; 




2245




 





 





 





 





 





 



 } 




2246




 





 





 





 





 





 



   




2247




 





 





 





 





 





 



 ###################################################################### 




2248




 





 





 





 





 





 



   




2249




 





 





 





 





 





 



 sub build_dmanip_routine_stmt { 




2250




 





 





 





 





 





 



     # SQL:2003, 13.5 "" (p790) 




2251




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2252




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_stmt', 




2253




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2254




 





 





 





 





 





 



     if (my $compound_stmt_routine = $rtn_stmt_node->get_attribute( 'block_routine' )) { 




2255




 





 





 





 





 





 



         return $builder->build_dmanip_routine_body( $compound_stmt_routine ); 




2256




 





 





 





 





 





 



     } 




2257




 





 





 





 





 





 



     elsif (my $assign_dest_node = $rtn_stmt_node->get_attribute( 'assign_dest' ) || 




2258




 





 





 





 





 





 



             $rtn_stmt_node->get_attribute( 'assign_dest' )) { 




2259




 





 





 





 





 





 



         my $dest = $builder->build_identifier_element( $assign_dest_node ); 




2260




 





 





 





 





 





 



         my $src = $builder->build_expr( 




2261




 





 





 





 





 





 



             $rtn_stmt_node->get_child_nodes( 'routine_expr' )->[0] ); 




2262




 





 





 





 





 





 



         if ($builder->{$PROP_ORA_ROUTINES}) { 




2263




 





 





 





 





 





 



             return $dest . ' := ' . $src . ';' . "\n"; 




2264




 





 





 





 





 





 



         } 




2265




 





 





 





 





 





 



         else { 




2266




 





 





 





 





 





 



             return 'SET ' . $dest . ' = ' . $src . ';' . "\n"; 




2267




 





 





 





 





 





 



         } 




2268




 





 





 





 





 





 



     } 




2269




 





 





 





 





 





 



     elsif ($rtn_stmt_node->get_attribute( 'call_sroutine' )) { 




2270




 





 





 





 





 





 



         return $builder->build_dmanip_call_sroutine( $rtn_stmt_node ); 




2271




 





 





 





 





 





 



     } 




2272




 





 





 





 





 





 



     elsif ($rtn_stmt_node->get_attribute( 'call_uroutine' )) { 




2273




 





 





 





 





 





 



         return $builder->build_dmanip_call_uroutine( $rtn_stmt_node ); 




2274




 





 





 





 





 





 



     } 




2275




 





 





 





 





 





 



     else {} 




2276




 





 





 





 





 





 



 } 




2277




 





 





 





 





 





 



   




2278




 





 





 





 





 





 



 ###################################################################### 




2279




 





 





 





 





 





 



   




2280




 





 





 





 





 





 



 sub build_dmanip_call_sroutine { 




2281




 





 





 





 





 





 



     # Corresponds to these sections: 




2282




 





 





 





 





 





 



     # SQL:2003, 14.2 "" (p815) 




2283




 





 





 





 





 





 



     # SQL:2003, 14.3 "" (p817) 




2284




 





 





 





 





 





 



     # SQL:2003, 14.4 "" (p822) 




2285




 





 





 





 





 





 



     # SQL:2003, 15.2 "" (p886) 




2286




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2287




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_call_sroutine', 




2288




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2289




 





 





 





 





 





 



     my $sroutine = $rtn_stmt_node->get_attribute( 'call_sroutine' ); 




2290




 





 





 





 





 





 



     my %child_exprs = map { ( 




2291




 





 





 





 





 





 



             ($_->get_attribute( 'call_sroutine_cxt' ) || 




2292




 





 





 





 





 





 



                 $_->get_attribute( 'call_sroutine_arg' )) => $_ 




2293




 





 





 





 





 





 



         ) } @{$rtn_stmt_node->get_child_nodes( 'routine_expr' )}; 




2294




 





 





 





 





 





 



     if ($sroutine eq 'RETURN') { 




2295




 





 





 





 





 





 



         my $return_value = $builder->build_expr( $child_exprs{'RETURN_VALUE'} ); 




2296




 





 





 





 





 





 



         return 'RETURN ' . $return_value . ';' . "\n"; # no parens in standard 




2297




 





 





 





 





 





 



     } 




2298




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_OPEN') { # opens a select cursor for reading from (or performs a select if in right context) 




2299




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2300




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2301




 





 





 





 





 





 



         return 'OPEN ' . $cursor_cx_name . ';' . "\n"; 




2302




 





 





 





 





 





 



     } 




2303




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_CLOSE') { # closes a select cursor when you're done with it 




2304




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2305




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2306




 





 





 





 





 





 



         return 'CLOSE ' . $cursor_cx_name . ';' . "\n"; 




2307




 





 





 





 





 





 



     } 




2308




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_FETCH') { # reads a row from an opened cursor and puts it in a row/list variable 




2309




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2310




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2311




 





 





 





 





 





 



         my $fetch_orient = $EMPTY_STR; # TODO: the explicit  options; NEXT is default 




2312




 





 





 





 





 





 



         my $query_dest_name = $builder->build_identifier_element( 




2313




 





 





 





 





 





 



             $child_exprs{'INTO'}->get_attribute( 'query_dest' ) ); 




2314




 





 





 





 





 





 



         return 'FETCH ' . $fetch_orient . ' FROM ' . $cursor_cx_name . ' INTO ' . $query_dest_name . ';' . "\n"; 




2315




 





 





 





 





 





 



     } 




2316




 





 





 





 





 





 



     elsif ($sroutine eq 'SELECT') { # fetches one row from a table/view and puts it in a row/list variable 




2317




 





 





 





 





 





 



         my $view_node = $child_exprs{'SELECT_DEFN'}->get_attribute( 'act_on' ); 




2318




 





 





 





 





 





 



         return $builder->build_query_query_spec( $view_node, 




2319




 





 





 





 





 





 



             $child_exprs{'INTO'}->get_attribute( 'query_dest' ) ) . ';' . "\n"; 




2320




 





 





 





 





 





 



     } 




2321




 





 





 





 





 





 



     elsif ($sroutine eq 'INSERT') { # inserts a row into a table/view 




2322




 





 





 





 





 





 



         my $view_node = $child_exprs{'INSERT_DEFN'}->get_attribute( 'act_on' ); 




2323




 





 





 





 





 





 



         return $builder->build_dmanip_insert_stmt( $view_node ); 




2324




 





 





 





 





 





 



     } 




2325




 





 





 





 





 





 



     elsif ($sroutine eq 'UPDATE') { # updates a row in a table/view 




2326




 





 





 





 





 





 



         my $view_node = $child_exprs{'UPDATE_DEFN'}->get_attribute( 'act_on' ); 




2327




 





 





 





 





 





 



         return $builder->build_dmanip_update_stmt( $view_node ); 




2328




 





 





 





 





 





 



     } 




2329




 





 





 





 





 





 



     elsif ($sroutine eq 'DELETE') { # deletes a row in a table/view 




2330




 





 





 





 





 





 



         my $view_node = $child_exprs{'DELETE_DEFN'}->get_attribute( 'act_on' ); 




2331




 





 





 





 





 





 



         return $builder->build_dmanip_delete_stmt( $view_node ); 




2332




 





 





 





 





 





 



     } 




2333




 





 





 





 





 





 



     elsif ($sroutine eq 'COMMIT') { # commits the current transaction, then starts a new one 




2334




 





 





 





 





 





 



         return 'COMMIT; START TRANSACTION;' . "\n"; 




2335




 





 





 





 





 





 



         # Note: According to the MySQL manual: 




2336




 





 





 





 





 





 



         # For transaction-safe tables, there are actions (other than typing COMMIT) 




2337




 





 





 





 





 





 



         # that will automatically trigger a COMMIT. Requesting a lock will implicitly 




2338




 





 





 





 





 





 



         # commit any outstanding queries. 




2339




 





 





 





 





 





 



     } 




2340




 





 





 





 





 





 



     elsif ($sroutine eq 'ROLLBACK') { # rolls back the current transaction, then starts a new one 




2341




 





 





 





 





 





 



         return 'ROLLBACK; START TRANSACTION;' . "\n"; # TODO: rollback to a named save point only 




2342




 





 





 





 





 





 



     } 




2343




 





 





 





 





 





 



     else {} # There are a bunch more that aren't implemented yet. 




2344




 





 





 





 





 





 



 } 




2345




 





 





 





 





 





 



   




2346




 





 





 





 





 





 



 ###################################################################### 




2347




 





 





 





 





 





 



   




2348




 





 





 





 





 





 



 sub build_dmanip_src_schema_object_name { 




2349




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2350




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_src_schema_object_name', 




2351




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2352




 





 





 





 





 





 



     my $view_type = $view_node->get_attribute( 'view_type' ); 




2353




 





 





 





 





 





 



     my @view_src_nodes = @{$view_node->get_child_nodes( 'view_src' )}; 




2354




 





 





 





 





 





 



     if (@view_src_nodes == 0) { 




2355




 





 





 





 





 





 



         return; # No source at all. 




2356




 





 





 





 





 





 



     } 




2357




 





 





 





 





 





 



     elsif ($view_type eq 'ALIAS' or @view_src_nodes == 1) { 




2358




 





 





 





 





 





 



         my $object_node = $view_src_nodes[0]->get_attribute( 'match' ); 




2359




 





 





 





 





 





 



         if ($object_node->get_primary_parent_attribute()->get_node_type() eq 'schema') { 




2360




 





 





 





 





 





 



             # The only source is a schema object, table or named view; use it directly. 




2361




 





 





 





 





 





 



             return $builder->build_identifier_schema_or_app_obj( $object_node ); 




2362




 





 





 





 





 





 



         } 




2363




 





 





 





 





 





 



         else { 




2364




 





 





 





 





 





 



             # The only source seems to be a sub-query in "from". 




2365




 





 





 





 





 





 



             return; # Adding recursion in all necessary places too complicated for now. 




2366




 





 





 





 





 





 



         } 




2367




 





 





 





 





 





 



     } 




2368




 





 





 





 





 





 



     else { # @view_src_nodes >= 2 




2369




 





 





 





 





 





 



         return; # Manual updates against multiple sources too complicated for now. 




2370




 





 





 





 





 





 



     } 




2371




 





 





 





 





 





 



 } 




2372




 





 





 





 





 





 



   




2373




 





 





 





 





 





 



 ###################################################################### 




2374




 





 





 





 





 





 



   




2375




 





 





 





 





 





 



 sub build_dmanip_insert_stmt { 




2376




 





 





 





 





 





 



     # SQL:2003, 7.3 "" (p298) 




2377




 





 





 





 





 





 



     # SQL:2003, 14.8 "" (p834) 




2378




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2379




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_insert_stmt', 




2380




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2381




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2382




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2383




 





 





 





 





 





 



     my @set_expr_nodes 




2384




 





 





 





 





 





 



         = grep { $_->get_attribute( 'view_part' ) eq 'SET' } 




2385




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




2386




 





 





 





 





 





 



     my @set_fields_list = (); 




2387




 





 





 





 





 





 



     my @set_values_list = (); 




2388




 





 





 





 





 





 



     for my $expr_node (@set_expr_nodes) { 




2389




 





 





 





 





 





 



         push @set_fields_list, $builder->build_identifier_element( 




2390




 





 





 





 





 





 



             $expr_node->get_attribute( 'set_src_field' ) ); 




2391




 





 





 





 





 





 



         push @set_values_list, $builder->build_expr( $expr_node ); 




2392




 





 





 





 





 





 



     } 




2393




 





 





 





 





 





 



     my $insert_fields_and_src = '(' . (join q{, }, @set_fields_list) . ') ' 




2394




 





 





 





 





 





 



         . 'VALUES (' . (join q{, }, @set_values_list) . ')'; 




2395




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2396




 





 





 





 





 





 



     return 'INSERT INTO ' . $object_name . ' ' . $insert_fields_and_src . ';' . "\n"; 




2397




 





 





 





 





 





 



 } 




2398




 





 





 





 





 





 



   




2399




 





 





 





 





 





 



 ###################################################################### 




2400




 





 





 





 





 





 



   




2401




 





 





 





 





 





 



 sub build_dmanip_update_stmt { 




2402




 





 





 





 





 





 



     # SQL:2003, 14.11 "" (p849) 




2403




 





 





 





 





 





 



     # SQL:2003, 14.12 "" (p853) 




2404




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2405




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_update_stmt', 




2406




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2407




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2408




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2409




 





 





 





 





 





 



     my @set_expr_nodes 




2410




 





 





 





 





 





 



         = grep { $_->get_attribute( 'view_part' ) eq 'SET' } 




2411




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




2412




 





 





 





 





 





 



     my @set_clause_list = (); 




2413




 





 





 





 





 





 



     for my $expr_node (@set_expr_nodes) { 




2414




 





 





 





 





 





 



         my $set_target = $builder->build_identifier_element( 




2415




 





 





 





 





 





 



             $expr_node->get_attribute( 'set_src_field' ) ); 




2416




 





 





 





 





 





 



         my $update_source = $builder->build_expr( $expr_node ); 




2417




 





 





 





 





 





 



         push @set_clause_list, $set_target . ' = ' . $update_source; 




2418




 





 





 





 





 





 



     } 




2419




 





 





 





 





 





 



     my $set_clause = 'SET ' . (join q{, }, @set_clause_list); 




2420




 





 





 





 





 





 



     my $where_clause = $builder->build_query_where_clause( $view_node ); 




2421




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2422




 





 





 





 





 





 



     return 'UPDATE ' . $object_name . ' ' . $set_clause . ' ' . $where_clause . ';' . "\n"; 




2423




 





 





 





 





 





 



 } 




2424




 





 





 





 





 





 



   




2425




 





 





 





 





 





 



 ###################################################################### 




2426




 





 





 





 





 





 



   




2427




 





 





 





 





 





 



 sub build_dmanip_delete_stmt { # SQL:2003, 14.7 "" (p831) 




2428




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2429




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_delete_stmt', 




2430




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2431




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2432




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2433




 





 





 





 





 





 



     my $where_clause = $builder->build_query_where_clause( $view_node ); 




2434




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2435




 





 





 





 





 





 



     return 'DELETE FROM ' . $object_name . ' ' . $where_clause . ';' . "\n"; 




2436




 





 





 





 





 





 



 } 




2437




 





 





 





 





 





 



   




2438




 





 





 





 





 





 



 ###################################################################### 




2439




 





 





 





 





 





 



   




2440




 





 





 





 





 





 



 sub build_dmanip_call_uroutine { 




2441




 





 





 





 





 





 



     # SQL:2003 ...  ... 




2442




 





 





 





 





 





 



     # SQL:2003, 15.1 "" (p885) 




2443




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2444




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_call_uroutine', 




2445




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2446




 





 





 





 





 





 



     my $uroutine = $rtn_stmt_node->get_attribute( 'call_uroutine' ); 




2447




 





 





 





 





 





 



     my $uroutine_name = $builder->build_identifier_schema_or_app_obj( $uroutine ); 




2448




 





 





 





 





 





 



     my %uroutine_arg_exprs 




2449




 





 





 





 





 





 



         = map { ($_->get_attribute( 'call_uroutine_arg' )->get_self_id() => $_) } 




2450




 





 





 





 





 





 



           @{$rtn_stmt_node->get_child_nodes( 'routine_expr' )}; 




2451




 





 





 





 





 





 



     # Note: The build_expr() calls are done below to ensure the arg values are 




2452




 





 





 





 





 





 



     # defined in the same order they are output; this lets optional insertion 




2453




 





 





 





 





 





 



     # of positionally determined host params (and their mapping) to work right. 




2454




 





 





 





 





 





 



     my $arg_val_list = join q{, }, 




2455




 





 





 





 





 





 



         map { $uroutine_arg_exprs{$_->get_self_id()} 




2456




 





 





 





 





 





 



               ? $builder->build_expr( $uroutine_arg_exprs{$_->get_self_id()} ) 




2457




 





 





 





 





 





 



               : 'NULL' } 




2458




 





 





 





 





 





 



         @{$uroutine->get_child_nodes( 'routine_arg' )}; 




2459




 





 





 





 





 





 



     #  ::= CALL  




2460




 





 





 





 





 





 



     return 'CALL ' . $uroutine_name . ($arg_val_list ? '(' . $arg_val_list . ')' : $EMPTY_STR) . ';' . "\n"; 




2461




 





 





 





 





 





 



 } 




2462




 





 





 





 





 





 



   




2463




 





 





 





 





 





 



 ###################################################################### 




2464




 





 





 





 





 





 



   




2465




 





 





 





 





 





 



 sub substitute_macros { 




2466




 





 





 





 





 





 



     my ($builder, $str, $subs) = @_; 




2467




 





 





 





 





 





 



     while (my ($key,$value) = each %{$subs}) { 




2468




 





 





 





 





 





 



         $str =~ s/ \{ $key \} /$value/x; 




2469




 





 





 





 





 





 



     } 




2470




 





 





 





 





 





 



     return $str; 




2471




 





 





 





 





 





 



 } 




2472




 





 





 





 





 





 



   




2473




 





 





 





 





 





 



 ###################################################################### 




2474




 





 





 





 





 





 



   




2475




 





 





 





 





 





 



 sub find_scalar_domain_for_row_domain_field { 




2476




 





 





 





 





 





 



     my ($builder, $scalar_data_type_node, $row_domain_node) = @_; 




2477




 





 





 





 





 





 



     my @candidates = grep { $_->get_attribute( 'data_type' )->get_self_id() eq $scalar_data_type_node->get_self_id() } 




2478




 





 





 





 





 





 



         @{$row_domain_node->get_primary_parent_attribute()->get_child_nodes( 'scalar_domain' )}; 




2479




 





 





 





 





 





 



     return $candidates[0] || $scalar_data_type_node; 




2480




 





 





 





 





 





 



 } 




2481




 





 





 





 





 





 



   




2482




 





 





 





 





 





 



 ###################################################################### 




2483




 





 





 





 





 





 



   




2484




 





 





 





 





 





 



 sub _scalar_data_type_of_node { 




2485




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2486




 





 





 





 





 





 



     $atnm ||= 'scalar_data_type'; 




2487




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2488




 





 





 





 





 





 



     if ($dt_or_dom_node->get_node_type() eq 'scalar_domain') { 




2489




 





 





 





 





 





 



         $dt_or_dom_node = $dt_or_dom_node->get_attribute( 'data_type' ); 




2490




 





 





 





 





 





 



     } 




2491




 





 





 





 





 





 



     return $dt_or_dom_node; 




2492




 





 





 





 





 





 



 } 




2493




 





 





 





 





 





 



   




2494




 





 





 





 





 





 



 sub _row_data_type_of_node { 




2495




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2496




 





 





 





 





 





 



     $atnm ||= 'row_data_type'; 




2497




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2498




 





 





 





 





 





 



     if ($dt_or_dom_node->get_node_type() eq 'row_domain') { 




2499




 





 





 





 





 





 



         $dt_or_dom_node = $dt_or_dom_node->get_attribute( 'data_type' ); 




2500




 





 





 





 





 





 



     } 




2501




 





 





 





 





 





 



     return $dt_or_dom_node; 




2502




 





 





 





 





 





 



 } 




2503




 





 





 





 





 





 



   




2504




 





 





 





 





 





 



 sub _row_domain_of_node { 




2505




 





 





 





 





 





 



     # returns domain or nothing 




2506




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2507




 





 





 





 





 





 



     $atnm ||= 'row_data_type'; 




2508




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2509




 





 





 





 





 





 



     return $dt_or_dom_node 




2510




 





 





 





 





 





 



         if $dt_or_dom_node->get_node_type() eq 'row_domain'; 




2511




 





 





 





 





 





 



     return; 




2512




 





 





 





 





 





 



 } 




2513




 





 





 





 





 





 



   




2514




 





 





 





 





 





 



 ###################################################################### 




2515




 





 





 





 





 





 



 # This is a 'protected' method; only sub-classes should invoke it. 




2516




 





 





 





 





 





 



   




2517




 





 





 





 





 





 



 sub _throw_error_message { 




2518




 





 





 





 





 





 



     my ($builder, $msg_key, $msg_vars) = @_; 




2519




 





 





 





 





 





 



     # Throws an exception consisting of an object. 




2520




 





 





 





 





 





 



     ref $msg_vars eq 'HASH' or $msg_vars = {}; 




2521




 





 





 





 





 





 



     for my $var_key (keys %{$msg_vars}) { 




2522




 





 





 





 





 





 



         if (ref $msg_vars->{$var_key} eq 'ARRAY') { 




2523




 





 





 





 





 





 



             $msg_vars->{$var_key} = 'PERL_ARRAY:[' . (join q{,},map {$_||$EMPTY_STR} @{$msg_vars->{$var_key}}) . ']'; 




2524




 





 





 





 





 





 



         } 




2525




 





 





 





 





 





 



     } 




2526




 





 





 





 





 





 



     die Locale::KeyedText->new_message( $msg_key, $msg_vars ); 




2527




 





 





 





 





 





 



 } 




2528




 





 





 





 





 





 



   




2529




 





 





 





 





 





 



 sub _assert_arg_node_type { 




2530




 





 





 





 





 





 



     my ($builder, $meth_name, $arg_name, $exp_node_types, $arg_value) = @_; 




2531




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_UNDEF', 




2532




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name } ) 




2533




 





 





 





 





 





 



         if !defined $arg_value; 




2534




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_NO_NODE', 




2535




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name, 'ARGVL' => $arg_value } ) 




2536




 





 





 





 





 





 



         if !ref $arg_value or !UNIVERSAL::isa( $arg_value, 'Rosetta::Model::Node' ); 




2537




 





 





 





 





 





 



     return 




2538




 





 





 





 





 





 



         if @{$exp_node_types} == 0; # any Node type is acceptable 




2539




 





 





 





 





 





 



     my $given_node_type = $arg_value->get_node_type(); 




2540




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_WRONG_NODE_TYPE', 




2541




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name, 




2542




 





 





 





 





 





 



         'EXPNTYPE' => $exp_node_types, 'ARGNTYPE' => $given_node_type } ) 




2543




 





 





 





 





 





 



         if !grep { $given_node_type eq $_ } @{$exp_node_types}; 




2544




 





 





 





 





 





 



     # If we get here, $arg_value is acceptable to the method. 




2545




 





 





 





 





 





 



 } 




2546




 





 





 





 





 





 



   




2547




 





 





 





 





 





 



 ###################################################################### 




2548




 





 





 





 





 





 



 ###################################################################### 




2549




 





 





 





 





 





 



   




2550




 





 





 





 





 





 



 1; 




2551




 





 





 





 





 





 



 __END__
    # SQL:2003, 7.7 "" (p312)
    # Method assumes that $view_node.view_type ne 'COMPOUND';
    # method should never be invoked for those kinds of views.
    # Function returns empty string if view has no 'from' clause (a rarity).
    my ($builder, $view_node) = @_;
    $builder->_assert_arg_node_type( 'build_query_from_clause',
        'VIEW_NODE', ['view'], $view_node );
    my $view_type = $view_node->get_attribute( 'view_type' );
    my @view_src_nodes = @{$view_node->get_child_nodes( 'view_src' )};
    my @view_join_nodes = @{$view_node->get_child_nodes( 'view_join' )};
    if (@view_src_nodes == 0) {
        # There are no sources, and hence, no 'from' clause.
        return $EMPTY_STR;
    }
    elsif ($view_type eq 'ALIAS' or @view_src_nodes == 1) {
        # Trivial case: There is exactly one source, aka a single ""; 




1328




 





 





 





 





 





 



         # it can be either a table or named view or subquery. 




1329




 





 





 





 





 





 



         return "\n" . 'FROM ' . $builder->build_query_table_factor( $view_src_nodes[0] ); 




1330




 





 





 





 





 





 



     } 




1331




 





 





 





 





 





 



     else { 




1332




 





 





 





 





 





 



         # Complex case: There are 2 or more sources that are being joined. 




1333




 





 





 





 





 





 



         # The first step is to determine the join order, and only afterwards are 




1334




 





 





 





 





 





 



         # each  rendered into SQL; each  must be 




1335




 





 





 





 





 





 



         # generated in appearance order, so positional host param mapping works right. 




1336




 





 





 





 





 





 



         # Note: This code isn't very smart and assumes that all the view_join Nodes 




1337




 





 





 





 





 





 



         # are declared in the same order they should be output, even if their is 




1338




 





 





 





 





 





 



         # other evidence to the contrary.  This code can be smartened later. 




1339




 





 





 





 





 





 



         # This code also assumes that the ROS M is correct, such that all defined 




1340




 





 





 





 





 





 



         # view_src Nodes are involved in a single common view_join; there should be 




1341




 





 





 





 





 





 



         # exactly one fewer view_join Node than there are view_src Nodes. 




1342




 





 





 





 





 





 



         # TODO: Support the Oracle-8 way of putting join conditions in WHERE. 




1343




 





 





 





 





 





 



         my @sql_fragment_list = (); 




1344




 





 





 





 





 





 



         push @sql_fragment_list, $builder->build_query_table_factor( 




1345




 





 





 





 





 





 



             $view_join_nodes[0]->get_attribute( 'lhs_src' ) ); 




1346




 





 





 





 





 





 



         for my $view_join_node (@view_join_nodes) { 




1347




 





 





 





 





 





 



             my $join_op = $view_join_node->get_attribute( 'join_op' ); 




1348




 





 





 





 





 





 



             push @sql_fragment_list, "\n" 




1349




 





 





 





 





 





 



                  . ( $join_op eq 'CROSS' ? 'CROSS JOIN' 




1350




 





 





 





 





 





 



                    : $join_op eq 'INNER' ? 'INNER JOIN' 




1351




 





 





 





 





 





 



                    : $join_op eq 'LEFT'  ? 'LEFT OUTER JOIN' 




1352




 





 





 





 





 





 



                    : $join_op eq 'RIGHT' ? 'RIGHT OUTER JOIN' 




1353




 





 





 





 





 





 



                    : $join_op eq 'FULL'  ? 'FULL OUTER JOIN' 




1354




 





 





 





 





 





 



                    :                       undef # we should never get here 




1355




 





 





 





 





 





 



                    ); 




1356




 





 





 





 





 





 



             push @sql_fragment_list, $builder->build_query_table_factor( 




1357




 





 





 





 





 





 



                 $view_join_node->get_attribute( 'rhs_src' ) ); 




1358




 





 





 





 





 





 



             my @join_on_sql = (); 




1359




 





 





 





 





 





 



             for my $view_join_field_node (@{$view_join_node->get_child_nodes( 'view_join_field' )}) { 




1360




 





 





 





 





 





 



                 my $lhs_src_field_name = $builder->build_identifier_view_src_field( 




1361




 





 





 





 





 





 



                     $view_join_field_node->get_attribute( 'lhs_src_field' ) ); 




1362




 





 





 





 





 





 



                 my $rhs_src_field_name = $builder->build_identifier_view_src_field( 




1363




 





 





 





 





 





 



                     $view_join_field_node->get_attribute( 'rhs_src_field' ) ); 




1364




 





 





 





 





 





 



                 push @join_on_sql, $rhs_src_field_name . ' = ' . $lhs_src_field_name; 




1365




 





 





 





 





 





 



             } 




1366




 





 





 





 





 





 



             push @sql_fragment_list, 'ON ' . (join ' AND ', @join_on_sql); 




1367




 





 





 





 





 





 



         } 




1368




 





 





 





 





 





 



         return "\n" . 'FROM ' . (join ' ', @sql_fragment_list); 




1369




 





 





 





 





 





 



     } 




1370




 





 





 





 





 





 



 } 




1371




 





 





 





 





 





 



   




1372




 





 





 





 





 





 



 sub build_query_table_factor { # SQL:2003, 7.6 "" (p303) 




1373




 





 





 





 





 





 



     my ($builder, $view_src_node) = @_; 




1374




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_table_factor', 




1375




 





 





 





 





 





 



         'VIEW_SRC_NODE', ['view_src'], $view_src_node ); 




1376




 





 





 





 





 





 



     # Maybe TODO:  




1377




 





 





 





 





 





 



     my $correlation_name = $builder->build_identifier_element( $view_src_node ); 




1378




 





 





 





 





 





 



     my $match_node = $view_src_node->get_attribute( 'match' ); 




1379




 





 





 





 





 





 



     my $match_name = $builder->build_identifier_schema_or_app_obj( $match_node ); 




1380




 





 





 





 





 





 



     if ($match_node->get_node_type() eq 'view') { 




1381




 





 





 





 





 





 



         if ($match_node->get_primary_parent_attribute()->get_node_type() eq 'view') { 




1382




 





 





 





 





 





 



             # The view we are matching is a subquery. 




1383




 





 





 





 





 





 



             if ($builder->{$PROP_INLINE_SUBQ}) { 




1384




 





 





 





 





 





 



                 # Embed an anonymous subquery; argument passing is not yet supported. 




1385




 





 





 





 





 





 



                 my $query_expression = $builder->build_query_query_expr( $match_node ); 




1386




 





 





 





 





 





 



                 return '(' . $query_expression . ') AS ' . $correlation_name; 




1387




 





 





 





 





 





 



             } 




1388




 





 





 





 





 





 



             else { 




1389




 





 





 





 





 





 



                 # Call a named subquery; argument passing is supported. 




1390




 





 





 





 





 





 



                 my %src_args_to_view_exprs 




1391




 





 





 





 





 





 



                     = map { ($_->get_attribute( 'call_src_arg' )->get_self_id() => $_) } 




1392




 





 





 





 





 





 



                       grep { $_->get_attribute( 'view_part' ) eq 'FROM' } 




1393




 





 





 





 





 





 



                       @{$view_src_node->get_primary_parent_attribute()->get_child_nodes( 'view_expr' )}; 




1394




 





 





 





 





 





 



                 my %view_args_to_src_args 




1395




 





 





 





 





 





 



                     = map { ($_->get_attribute( 'match_view_arg' )->get_self_id() => $_) } 




1396




 





 





 





 





 





 



                       @{$view_src_node->get_child_nodes( 'view_src_arg' )}; 




1397




 





 





 





 





 





 



                 # Note: The build_expr() calls are done below to ensure the arg values are 




1398




 





 





 





 





 





 



                 # defined in the same order they are output; this lets optional insertion 




1399




 





 





 





 





 





 



                 # of positionally determined host params (and their mapping) to work right. 




1400




 





 





 





 





 





 



                 my $arg_list = join q{, }, 




1401




 





 





 





 





 





 



                     map { ($_ ? $builder->build_expr( $_ ) : 'NULL') } 




1402




 





 





 





 





 





 



                     map { $src_args_to_view_exprs{$view_args_to_src_args{$_->get_self_id()}->get_self_id()} } 




1403




 





 





 





 





 





 



                     @{$match_node->get_child_nodes( 'view_arg' )}; 




1404




 





 





 





 





 





 



                 return $match_name 




1405




 





 





 





 





 





 



                        . ($arg_list ? '(' . $arg_list . ')' : $EMPTY_STR) 




1406




 





 





 





 





 





 



                        . ' AS ' . $correlation_name; 




1407




 





 





 





 





 





 



             } 




1408




 





 





 





 





 





 



         } 




1409




 





 





 





 





 





 



         else { 




1410




 





 





 





 





 





 



             # The view we are matching is a schema object. 




1411




 





 





 





 





 





 



             return $match_name . ' AS ' . $correlation_name; 




1412




 





 





 





 





 





 



         } 




1413




 





 





 





 





 





 



     } 




1414




 





 





 





 





 





 



     else { # the source node is a base table schema object or a local variable of some kind 




1415




 





 





 





 





 





 



         return $match_name . ' AS ' . $correlation_name; 




1416




 





 





 





 





 





 



     } 




1417




 





 





 





 





 





 



 } 




1418




 





 





 





 





 





 



   




1419




 





 





 





 





 





 



 ###################################################################### 




1420




 





 





 





 





 





 



   




1421




 





 





 





 





 





 



 sub build_query_where_clause { # SQL:2003, 7.8 "" (p319) 




1422




 





 





 





 





 





 



     # Function returns empty string if view has no where clause. 




1423




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1424




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_where_clause', 




1425




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1426




 





 





 





 





 





 



     my @expr_list 




1427




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1428




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'WHERE' } 




1429




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1430




 





 





 





 





 





 



     return @expr_list ? "\n" . 'WHERE ' . $expr_list[0] : $EMPTY_STR; 




1431




 





 





 





 





 





 



 } 




1432




 





 





 





 





 





 



   




1433




 





 





 





 





 





 



 ###################################################################### 




1434




 





 





 





 





 





 



   




1435




 





 





 





 





 





 



 sub build_query_group_clause { # SQL:2003, 7.9 "" (p320) 




1436




 





 





 





 





 





 



     # Function returns empty string if view has no group by clause. 




1437




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1438




 





 





 





 





 





 



     my @expr_list 




1439




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1440




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'GROUP' } 




1441




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1442




 





 





 





 





 





 



     return @expr_list ? "\n" . 'GROUP BY ' . (join q{, }, @expr_list) : $EMPTY_STR; 




1443




 





 





 





 





 





 



     # Notes: Within build_expr(): 




1444




 





 





 





 





 





 



     #  implemented by COL basic_expr_type, 




1445




 





 





 





 





 





 



     #  and  implemented by LIST basic_expr_type, 




1446




 





 





 





 





 





 



     #  impl by ROSMN named GB_SETS, 




1447




 





 





 





 





 





 



     #  impl by ROSMN named GB_RLUP, 




1448




 





 





 





 





 





 



     #  impl by ROSMN named GB_CUBE. 




1449




 





 





 





 





 





 



     # Note:  has opt , looks redundant w SEL DIST|ALL; not impl. 




1450




 





 





 





 





 





 



 } 




1451




 





 





 





 





 





 



   




1452




 





 





 





 





 





 



 ###################################################################### 




1453




 





 





 





 





 





 



   




1454




 





 





 





 





 





 



 sub build_query_having_clause { # SQL:2003, 7.10 "" (p329) 




1455




 





 





 





 





 





 



     # Function returns empty string if view has no having clause. 




1456




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1457




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_having_clause', 




1458




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1459




 





 





 





 





 





 



     my @expr_list 




1460




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1461




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'HAVING' } 




1462




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1463




 





 





 





 





 





 



     return @expr_list ? "\n" . 'HAVING ' . $expr_list[0] : $EMPTY_STR; 




1464




 





 





 





 





 





 



 } 




1465




 





 





 





 





 





 



   




1466




 





 





 





 





 





 



 ###################################################################### 




1467




 





 





 





 





 





 



   




1468




 





 





 





 





 





 



 sub build_query_window_clause { # SQL:2003, 7.11 "" (p331) 




1469




 





 





 





 





 





 



     # Function returns empty string if view has no window clause. 




1470




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1471




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_window_clause', 




1472




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1473




 





 





 





 





 





 



     # TODO: I need to first update Rosetta::Model a bit re the various 




1474




 





 





 





 





 





 



     # parts of a , then fix here.  Meanwhile, I dump what I got. 




1475




 





 





 





 





 





 



     # Also see SQL:2003, 10.10 "" (p517) for future reference. 




1476




 





 





 





 





 





 



     my @order_list 




1477




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1478




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'ORDER' } 




1479




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1480




 





 





 





 





 





 



     my @maxr_list 




1481




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1482




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'MAXR' } 




1483




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1484




 





 





 





 





 





 



     my @skipr_list 




1485




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1486




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'SKIPR' } 




1487




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1488




 





 





 





 





 





 



     return (@order_list ? "\n" . 'ORDER BY ' . (join q{, }, @order_list) : $EMPTY_STR) 




1489




 





 





 





 





 





 



            . (@maxr_list ? "\n" . 'LIMIT ' . $maxr_list[0] : $EMPTY_STR) 




1490




 





 





 





 





 





 



            . (@skipr_list ? "\n" . 'OFFSET ' . $skipr_list[0] : $EMPTY_STR); 




1491




 





 





 





 





 





 



 } 




1492




 





 





 





 





 





 



   




1493




 





 





 





 





 





 



 ###################################################################### 




1494




 





 





 





 





 





 



   




1495




 





 





 





 





 





 



 sub build_query_query_spec { 




1496




 





 





 





 





 





 



     # SQL:2003, 7.12 "" (p341) 




1497




 





 





 





 





 





 



     # SQL:2003, 14.5 "" (p824) 




1498




 





 





 





 





 





 



     my ($builder, $view_node, $into_dest_node) = @_; 




1499




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_query_spec', 




1500




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1501




 





 





 





 





 





 



     defined $into_dest_node and $builder->_assert_arg_node_type( 'build_query_query_spec', 




1502




 





 





 





 





 





 



         'INTO_DEST_NODE', ['routine_arg','routine_var'], $into_dest_node ); 




1503




 





 





 





 





 





 



     # Method assumes that $view_node.view_type ne 'COMPOUND'; 




1504




 





 





 





 





 





 



     # method should never be invoked for those kinds of views. 




1505




 





 





 





 





 





 



     my $set_quantifier = $view_node->get_attribute( 'distinct_rows' ) ? 'DISTINCT' : 'ALL'; 




1506




 





 





 





 





 





 



     my $select_list = $builder->build_query_select_list( $view_node ); 




1507




 





 





 





 





 





 



     my $into_clause = $into_dest_node ? "\n" . 'INTO ' . $builder->build_identifier_element( $into_dest_node ) : $EMPTY_STR; 




1508




 





 





 





 





 





 



     my $table_expression = $builder->build_query_table_expr( $view_node ); 




1509




 





 





 





 





 





 



     return "\n" . 'SELECT ' . $set_quantifier . ' ' . $select_list . $into_clause . $table_expression; 




1510




 





 





 





 





 





 



 } 




1511




 





 





 





 





 





 



   




1512




 





 





 





 





 





 



 ###################################################################### 




1513




 





 





 





 





 





 



   




1514




 





 





 





 





 





 



 sub build_query_select_list { # SQL:2003, 7.12 "" (p341) 




1515




 





 





 





 





 





 



     # Method returns comma-delimited list expression where each list item is a 




1516




 





 





 





 





 





 



     # " ::=  AS ". 




1517




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1518




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_select_list', 




1519




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1520




 





 





 





 





 





 



     if ($view_node->get_attribute( 'view_type' ) eq 'ALIAS') { 




1521




 





 





 





 





 





 



         # Each result column must match a source column exactly. 




1522




 





 





 





 





 





 



         # Every source table/view result column or var field is output, with the same name. 




1523




 





 





 





 





 





 



         # It is assumed/required that the view has the same 'row_data_type' as the source. 




1524




 





 





 





 





 





 



         # While '*' would conceptually work here, we still explicitly enumerate col name list 




1525




 





 





 





 





 





 



         # so compound selects and select-intos don't break when original create tbl/vw statement 




1526




 





 





 





 





 





 



         # had declared columns in a different order than our row-data-type does. 




1527




 





 





 





 





 





 



         my $row_data_type_node = $builder->_row_data_type_of_node( $view_node ); 




1528




 





 





 





 





 





 



         return join q{, } . "\n", 




1529




 





 





 





 





 





 



             map { $builder->build_identifier_element( $_ ) } 




1530




 





 





 





 





 





 



             @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}; 




1531




 





 





 





 





 





 



     } 




1532




 





 





 





 





 





 



     else { # view_type ne 'ALIAS' 




1533




 





 





 





 





 





 



         # Each result column may come from an arbitrarily complex expression. 




1534




 





 





 





 





 





 



         # We have three statements below instead of one because we want the result cols shown 




1535




 





 





 





 





 





 



         # in order of the view's "row_data_type_field" Nodes, not the order of the 'view_part' if different. 




1536




 





 





 





 





 





 



         my %select_list_view_fields 




1537




 





 





 





 





 





 



             = map { ($_->get_attribute( 'si_row_field' )->get_self_id() => $_->get_attribute( 'src_field' )) } 




1538




 





 





 





 





 





 



               @{$view_node->get_child_nodes( 'view_field' )}; # note: 'src_field' may be undefined 




1539




 





 





 





 





 





 



         my %select_list_view_exprs 




1540




 





 





 





 





 





 



             = map { ($_->get_attribute( 'set_result_field' )->get_self_id() => $_) } 




1541




 





 





 





 





 





 



               grep { $_->get_attribute( 'view_part' ) eq 'RESULT' } 




1542




 





 





 





 





 





 



               @{$view_node->get_child_nodes( 'view_expr' )}; 




1543




 





 





 





 





 





 



         # Note: The build_expr() calls are done below to ensure the arg values are 




1544




 





 





 





 





 





 



         # defined in the same order they are output; this lets optional insertion 




1545




 





 





 





 





 





 



         # of positionally determined host params (and their mapping) to work right. 




1546




 





 





 





 





 





 



         my $row_data_type_node = $builder->_row_data_type_of_node( $view_node ); 




1547




 





 





 





 





 





 



         return join q{, } . "\n", 




1548




 





 





 





 





 





 



             map { ($select_list_view_fields{$_->get_self_id()} 




1549




 





 





 





 





 





 



                    ? $builder->build_identifier_view_src_field( $select_list_view_fields{$_->get_self_id()} ) 




1550




 





 





 





 





 





 



                    : $select_list_view_exprs{$_->get_self_id()} 




1551




 





 





 





 





 





 



                    ? $builder->build_expr( $select_list_view_exprs{$_->get_self_id()} ) 




1552




 





 





 





 





 





 



                    : 'NULL') 




1553




 





 





 





 





 





 



                 . ' AS ' . $builder->build_identifier_element( $_ ) } 




1554




 





 





 





 





 





 



             @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}; 




1555




 





 





 





 





 





 



         # Note that the default of NULL thing deals with view's row field that don't have any view_expr or src_field. 




1556




 





 





 





 





 





 



         # TODO IF NOT WRONG/OUTDATED: Note that the 'view_field' Nodes we actually need may be in a parent view 




1557




 





 





 





 





 





 



         # of the current view; right now we only are looking in the current view. 




1558




 





 





 





 





 





 



     } 




1559




 





 





 





 





 





 



 } 




1560




 





 





 





 





 





 



   




1561




 





 





 





 





 





 



 ###################################################################### 




1562




 





 





 





 





 





 



   




1563




 





 





 





 





 





 



 sub build_query_query_expr { # SQL:2003, 7.13 "" (p351) 




1564




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1565




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_query_expr', 




1566




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1567




 





 





 





 





 





 



     my $view_type = $view_node->get_attribute( 'view_type' ); 




1568




 





 





 





 





 





 



     my $with_clause = $EMPTY_STR; 




1569




 





 





 





 





 





 



     if (!$builder->{$PROP_INLINE_SUBQ}) { 




1570




 





 





 





 





 





 



         my @with_list = (); 




1571




 





 





 





 





 





 



         my $recursive = 0; 




1572




 





 





 





 





 





 



         for my $child_view_node (@{$view_node->get_child_nodes( 'view' )}) { 




1573




 





 





 





 





 





 



             if ($child_view_node->get_attribute( 'recursive' )) { 




1574




 





 





 





 





 





 



                 $recursive = 1; 




1575




 





 





 





 





 





 



             } 




1576




 





 





 





 





 





 



             my $with_item = $builder->build_identifier_element( $child_view_node ); 




1577




 





 





 





 





 





 



             if (my @child_arg_nodes = @{$child_view_node->get_child_nodes( 'view_arg' )}) { 




1578




 





 





 





 





 





 



                 $with_item .= '(' . (join q{, }, 




1579




 





 





 





 





 





 



                     map { $builder->build_identifier_element( $_ ) } 




1580




 





 





 





 





 





 



                     @child_arg_nodes) . ')'; 




1581




 





 





 





 





 





 



             } 




1582




 





 





 





 





 





 



             $with_item .= ' AS (' . $builder->build_query_query_expr( $child_view_node ) . ')'; 




1583




 





 





 





 





 





 



             push @with_list, $with_item; 




1584




 





 





 





 





 





 



         } 




1585




 





 





 





 





 





 



         if (@with_list) { 




1586




 





 





 





 





 





 



             $with_clause = "\n" . 'WITH ' . ($recursive ? 'RECURSIVE ' : $EMPTY_STR) . (join q{, }, @with_list); 




1587




 





 





 





 





 





 



         } 




1588




 





 





 





 





 





 



     } 




1589




 





 





 





 





 





 



     my $query_expression_body = $builder->build_query_query_expr_body( $view_node ); 




1590




 





 





 





 





 





 



     return $with_clause . $query_expression_body; 




1591




 





 





 





 





 





 



     # TODO: SQL:2003, 7.14 "" (p365). 




1592




 





 





 





 





 





 



 } 




1593




 





 





 





 





 





 



   




1594




 





 





 





 





 





 



 ###################################################################### 




1595




 





 





 





 





 





 



   




1596




 





 





 





 





 





 



 sub build_query_query_expr_body { # SQL:2003, 7.13 "" (p351) 




1597




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1598




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_query_expr_body', 




1599




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1600




 





 





 





 





 





 



     if ($view_node->get_attribute( 'view_type' ) eq 'COMPOUND') { 




1601




 





 





 





 





 





 



         # Result is multiple "SELECT ..." connected by one or more compound operators. 




1602




 





 





 





 





 





 



         my $compound_op = $view_node->get_attribute( 'compound_op' ); 




1603




 





 





 





 





 





 



         my $set_quantifier = $view_node->get_attribute( 'distinct_rows' ) ? 'DISTINCT' : 'ALL'; 




1604




 





 





 





 





 





 



         my @operand_list = (); 




1605




 





 





 





 





 





 



         for my $elem_node (@{$view_node->get_child_nodes( 'view_compound_elem' )}) { 




1606




 





 





 





 





 





 



             my $view_src_node = $elem_node->get_attribute( 'operand' ); 




1607




 





 





 





 





 





 



             my $match_node = $view_src_node->get_attribute( 'match' ); 




1608




 





 





 





 





 





 



             my $match_name = $builder->build_identifier_schema_or_app_obj( $match_node ); 




1609




 





 





 





 





 





 



             # Each compounding operand is assumed to have the same row data type as the view. 




1610




 





 





 





 





 





 



             if ($match_node->get_node_type() eq 'table') { 




1611




 





 





 





 





 





 



                 my $row_data_type_node = $builder->_row_data_type_of_node( $match_node ); 




1612




 





 





 





 





 





 



                 push @operand_list, join q{, } . "\n", 




1613




 





 





 





 





 





 



                     map { $builder->build_identifier_element( $_ ) } 




1614




 





 





 





 





 





 



                     @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}; 




1615




 





 





 





 





 





 



             } 




1616




 





 





 





 





 





 



             elsif ($match_node->get_node_type() eq 'view') { 




1617




 





 





 





 





 





 



                 push @operand_list, $builder->build_query_query_expr( $match_node ); 




1618




 





 





 





 





 





 



             } 




1619




 





 





 





 





 





 



             else { # the source node is a local variable of some kind 




1620




 





 





 





 





 





 



                 push @operand_list, $match_name; 




1621




 





 





 





 





 





 



             } 




1622




 





 





 





 





 





 



         } 




1623




 





 





 





 





 





 



         my $sql_operator 




1624




 





 





 





 





 





 



             = $compound_op eq 'UNION'        ? 'UNION' 




1625




 





 





 





 





 





 



             : $compound_op eq 'DIFFERENCE'   ? 'EXCEPT' 




1626




 





 





 





 





 





 



             : $compound_op eq 'INTERSECTION' ? 'INTERSECT' 




1627




 





 





 





 





 





 



             : $compound_op eq 'EXCLUSION'    ? 'EXCLUSION' # this 4th option not in SQL:2003. 




1628




 





 





 





 





 





 



             :                                  undef # we should never get here 




1629




 





 





 





 





 





 



             ; 




1630




 





 





 





 





 





 



             # TODO: try to emulate 'EXCLUSION' somewhere. 




1631




 





 





 





 





 





 



         return '(' . (join "\n" . $sql_operator . '_' . $set_quantifier, @operand_list) . ')'; 




1632




 





 





 





 





 





 



         # TODO: deal with engines that don't like "()" bounding compound operations. 




1633




 





 





 





 





 





 



         # TODO: possibly implement . 




1634




 





 





 





 





 





 



     } 




1635




 





 





 





 





 





 



     else { # view type ne 'COMPOUND' 




1636




 





 





 





 





 





 



         # Result is a single "SELECT ...", also known as a single "". 




1637




 





 





 





 





 





 



         return $builder->build_query_query_spec( $view_node ); 




1638




 





 





 





 





 





 



     } 




1639




 





 





 





 





 





 



 } 




1640




 





 





 





 





 





 



   




1641




 





 





 





 





 





 



 ###################################################################### 




1642




 





 





 





 





 





 



   




1643




 





 





 





 





 





 



 sub build_query_subquery { # SQL:2003, 7.15 "" (p370) 




1644




 





 





 





 





 





 



     my ($builder, $expr_node) = @_; 




1645




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_subquery', 




1646




 





 





 





 





 





 



         'EXPR_NODE', ['view_expr'], $expr_node ); 




1647




 





 





 





 





 





 



     my $cview = $expr_node->get_attribute( 'valf_call_view' ); 




1648




 





 





 





 





 





 



     if ($builder->{$PROP_INLINE_SUBQ}) { 




1649




 





 





 





 





 





 



         # Embed an anonymous subquery; argument passing is not yet supported. 




1650




 





 





 





 





 





 



         my $query_expression = $builder->build_query_query_expr( $cview ); 




1651




 





 





 





 





 





 



         return '(' . $query_expression . ')'; 




1652




 





 





 





 





 





 



     } 




1653




 





 





 





 





 





 



     else { 




1654




 





 





 





 





 





 



         # Call a named subquery; argument passing is supported. 




1655




 





 





 





 





 





 



         my $cview_name = $builder->build_identifier_schema_or_app_obj( $cview ); 




1656




 





 





 





 





 





 



         my %cview_arg_exprs 




1657




 





 





 





 





 





 



             = map { ($_->get_attribute( 'call_view_arg' )->get_self_id() => $_) } 




1658




 





 





 





 





 





 



               @{$expr_node->get_child_nodes()}; # gets child view_expr Nodes 




1659




 





 





 





 





 





 



         # Note: The build_expr() calls are done below to ensure the arg values are 




1660




 





 





 





 





 





 



         # defined in the same order they are output; this lets optional insertion 




1661




 





 





 





 





 





 



         # of positionally determined host params (and their mapping) to work right. 




1662




 





 





 





 





 





 



         my $arg_val_list = join q{, }, 




1663




 





 





 





 





 





 



             map { $cview_arg_exprs{$_->get_self_id()} 




1664




 





 





 





 





 





 



                   ? $builder->build_expr( $cview_arg_exprs{$_->get_self_id()} ) 




1665




 





 





 





 





 





 



                   : 'NULL' } 




1666




 





 





 





 





 





 



             @{$cview->get_child_nodes( 'view_arg' )}; 




1667




 





 





 





 





 





 



         return $cview_name . ($arg_val_list ? '(' . $arg_val_list . ')' : $EMPTY_STR); 




1668




 





 





 





 





 





 



     } 




1669




 





 





 





 





 





 



     # Note: Direct calls to schema object tables or views is not supported outside of 'FROM'. 




1670




 





 





 





 





 





 



 } 




1671




 





 





 





 





 





 



   




1672




 





 





 





 





 





 



 ###################################################################### 




1673




 





 





 





 





 





 



   




1674




 





 





 





 





 





 



 sub build_schema_create { # SQL:2003, 11.1 "" (p519) 




1675




 





 





 





 





 





 



     my ($builder, $schema_node) = @_; 




1676




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_create', 




1677




 





 





 





 





 





 



         'SCHEMA_NODE', ['schema'], $schema_node ); 




1678




 





 





 





 





 





 



     my $schema_name = $builder->build_identifier_element( $schema_node ); 




1679




 





 





 





 





 





 



     my $authorization = $EMPTY_STR; # TODO: AUTHORIZATION  




1680




 





 





 





 





 





 



     # Some other features in 11.1, such as default character set. 




1681




 





 





 





 





 





 



     return 'CREATE SCHEMA ' . $schema_name . ' ' . $authorization . ';' . "\n"; 




1682




 





 





 





 





 





 



 } 




1683




 





 





 





 





 





 



   




1684




 





 





 





 





 





 



 sub build_schema_delete { # SQL:2003, 11.2 "" (p522) 




1685




 





 





 





 





 





 



     my ($builder, $schema_node) = @_; 




1686




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_delete', 




1687




 





 





 





 





 





 



         'SCHEMA_NODE', ['schema'], $schema_node ); 




1688




 





 





 





 





 





 



     my $schema_name = $builder->build_identifier_element( $schema_node ); 




1689




 





 





 





 





 





 



     return 'DROP SCHEMA ' . $schema_name . ';' . "\n"; 




1690




 





 





 





 





 





 



 } 




1691




 





 





 





 





 





 



   




1692




 





 





 





 





 





 



 ###################################################################### 




1693




 





 





 





 





 





 



   




1694




 





 





 





 





 





 



 sub build_schema_or_app_scalar_domain_create { # SQL:2003, 11.24 "" (p603) 




1695




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1696




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_scalar_domain_create', 




1697




 





 





 





 





 





 



         'DOMAIN_NODE', ['scalar_domain'], $domain_node ); 




1698




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1699




 





 





 





 





 





 



     my $predefined_type = $builder->build_expr_scalar_data_type_defn( $domain_node ); 




1700




 





 





 





 





 





 



     # TODO: default clause, domain constraint, collate clause. 




1701




 





 





 





 





 





 



     my $is_temp = ($domain_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1702




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' DOMAIN ' . $domain_name . ' AS ' . $predefined_type . ';' . "\n"; 




1703




 





 





 





 





 





 



 } 




1704




 





 





 





 





 





 



   




1705




 





 





 





 





 





 



 sub build_schema_or_app_scalar_domain_delete { # SQL:2003, 11.30 "" (p610) 




1706




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1707




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_scalar_domain_delete', 




1708




 





 





 





 





 





 



         'DOMAIN_NODE', ['scalar_domain'], $domain_node ); 




1709




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1710




 





 





 





 





 





 



     return 'DROP DOMAIN ' . $domain_name . ';' . "\n"; 




1711




 





 





 





 





 





 



 } 




1712




 





 





 





 





 





 



   




1713




 





 





 





 





 





 



 ###################################################################### 




1714




 





 





 





 





 





 



   




1715




 





 





 





 





 





 



 sub build_schema_or_app_row_domain_create { # SQL:2003, 11.24 "" (p603) 




1716




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1717




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_row_domain_create', 




1718




 





 





 





 





 





 



         'DOMAIN_NODE', ['row_domain'], $domain_node ); 




1719




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1720




 





 





 





 





 





 



     my $predefined_type = $builder->build_expr_row_data_type_defn( $domain_node ); 




1721




 





 





 





 





 





 



     # TODO: default clause, domain constraint, collate clause. 




1722




 





 





 





 





 





 



     my $is_temp = ($domain_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1723




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' DOMAIN ' . $domain_name . ' AS ' . $predefined_type . ';' . "\n"; 




1724




 





 





 





 





 





 



 } 




1725




 





 





 





 





 





 



   




1726




 





 





 





 





 





 



 sub build_schema_or_app_row_domain_delete { # SQL:2003, 11.30 "" (p610) 




1727




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1728




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_row_domain_delete', 




1729




 





 





 





 





 





 



         'DOMAIN_NODE', ['row_domain'], $domain_node ); 




1730




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1731




 





 





 





 





 





 



     return 'DROP DOMAIN ' . $domain_name . ';' . "\n"; 




1732




 





 





 





 





 





 



 } 




1733




 





 





 





 





 





 



   




1734




 





 





 





 





 





 



 ###################################################################### 




1735




 





 





 





 





 





 



   




1736




 





 





 





 





 





 



 sub build_schema_or_app_sequence_create { # SQL:2003, 11.62 "" (p726) 




1737




 





 





 





 





 





 



     my ($builder, $sequence_node) = @_; 




1738




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_sequence_create', 




1739




 





 





 





 





 





 



         'SEQUENCE_NODE', ['sequence'], $sequence_node ); 




1740




 





 





 





 





 





 



     # SQL:2003 allows multiple data types for this, but we stick to integers for now. 




1741




 





 





 





 





 





 



     my $sequence_name = $builder->build_identifier_schema_or_app_obj( $sequence_node, 1 ); 




1742




 





 





 





 





 





 



     my $increment = $sequence_node->get_attribute( 'increment' ); 




1743




 





 





 





 





 





 



     my $min_val = $sequence_node->get_attribute( 'min_val' ); 




1744




 





 





 





 





 





 



     my $max_val = $sequence_node->get_attribute( 'max_val' ); 




1745




 





 





 





 





 





 



     my $start_val = $sequence_node->get_attribute( 'start_val' ); 




1746




 





 





 





 





 





 



     my $cycle = $sequence_node->get_attribute( 'cycle' ); 




1747




 





 





 





 





 





 



     my $order = $sequence_node->get_attribute( 'order' ); 




1748




 





 





 





 





 





 



     # Note that Rosetta::Model guarantees all integer attributes are already valid integers. 




1749




 





 





 





 





 





 



     my $is_temp = ($sequence_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1750




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' SEQUENCE ' . $sequence_name 




1751




 





 





 





 





 





 



         . (defined $increment ? ' INCREMENT BY ' . $increment : $EMPTY_STR) 




1752




 





 





 





 





 





 



         . (defined $start_val ? ' START WITH ' . $start_val : $EMPTY_STR) 




1753




 





 





 





 





 





 



         . (defined $min_val ? ' MINVALUE ' . $min_val : ' NO MINVALUE') 




1754




 





 





 





 





 





 



         . (defined $max_val ? ' MAXVALUE ' . $max_val : ' NO MAXVALUE') 




1755




 





 





 





 





 





 



         . ($cycle ? ' CYCLE' : ' NO CYCLE') 




1756




 





 





 





 





 





 



         . ($order ? ' ORDER' : ' NO ORDER') # standard doesn't mention this one 




1757




 





 





 





 





 





 



         . ';' . "\n"; 




1758




 





 





 





 





 





 



 } 




1759




 





 





 





 





 





 



   




1760




 





 





 





 





 





 



 sub build_schema_or_app_sequence_delete { # SQL:2003, 11.64 "" (p729) 




1761




 





 





 





 





 





 



     my ($builder, $sequence_node) = @_; 




1762




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_sequence_delete', 




1763




 





 





 





 





 





 



         'SEQUENCE_NODE', ['sequence'], $sequence_node ); 




1764




 





 





 





 





 





 



     my $sequence_name = $builder->build_identifier_schema_or_app_obj( $sequence_node, 1 ); 




1765




 





 





 





 





 





 



     return 'DROP SEQUENCE ' . $sequence_name . ';' . "\n"; 




1766




 





 





 





 





 





 



 } 




1767




 





 





 





 





 





 



   




1768




 





 





 





 





 





 



 ###################################################################### 




1769




 





 





 





 





 





 



   




1770




 





 





 





 





 





 



 sub build_schema_or_app_table_create { 




1771




 





 





 





 





 





 



     # SQL:2003, 6.2 "" (p173) 




1772




 





 





 





 





 





 



     # SQL:2003, 11.3 "" (p525) 




1773




 





 





 





 





 





 



     # SQL:2003, 11.4 "" (p536) 




1774




 





 





 





 





 





 



     # SQL:2003, 11.5 "" (p541) 




1775




 





 





 





 





 





 



     # SQL:2003, 11.6 "" (p545) 




1776




 





 





 





 





 





 



     # SQL:2003, 11.7 "" (p547) 




1777




 





 





 





 





 





 



     # SQL:2003, 11.8 "" (p549) 




1778




 





 





 





 





 





 



     # TODO: SQL:2003, 11.9 "" (p569) 




1779




 





 





 





 





 





 



     # TODO: "GENERATED ALWAYS AS ..." which looks like FileMaker's (etc) "calculation" field types. 




1780




 





 





 





 





 





 



     my ($builder, $table_node) = @_; 




1781




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_table_create', 




1782




 





 





 





 





 





 



         'TABLE_NODE', ['table'], $table_node ); 




1783




 





 





 





 





 





 



     my $table_name = $builder->build_identifier_schema_or_app_obj( $table_node, 1 ); 




1784




 





 





 





 





 





 



     my @table_field_sql = (); 




1785




 





 





 





 





 





 



     my %col_name_cache = (); # used when making ind defs 




1786




 





 





 





 





 





 



     my %mandatory_field_cache = (); # used when making ind defs 




1787




 





 





 





 





 





 



     my %table_fields_by_row_field = map { ($_->get_attribute( 'si_row_field' )->get_self_id() => $_) } 




1788




 





 





 





 





 





 



         @{$table_node->get_child_nodes( 'table_field' )}; 




1789




 





 





 





 





 





 



     my $row_data_type_node = $builder->_row_data_type_of_node( $table_node ); # is always set 




1790




 





 





 





 





 





 



     my $row_domain_node = $builder->_row_domain_of_node( $table_node ); # may be undefined 




1791




 





 





 





 





 





 



     for my $row_field_node (@{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}) { 




1792




 





 





 





 





 





 



         my $table_field_name = $builder->build_identifier_element( $row_field_node ); 




1793




 





 





 





 





 





 



         if (!exists $col_name_cache{$row_field_node->get_self_id()}) { 




1794




 





 





 





 





 





 



             $col_name_cache{$row_field_node->get_self_id()} = $table_field_name; 




1795




 





 





 





 





 





 



         } 




1796




 





 





 





 





 





 



         my $scalar_data_type_node = $row_field_node->get_attribute( 'scalar_data_type' ); 




1797




 





 





 





 





 





 



         my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( 




1798




 





 





 





 





 





 



             $row_domain_node ? $builder->find_scalar_domain_for_row_domain_field( 




1799




 





 





 





 





 





 



             $scalar_data_type_node, $row_domain_node ) : $scalar_data_type_node ); 




1800




 





 





 





 





 





 



         my $table_field_sql_item = $table_field_name . ' ' . $dt_or_dom_sql; 




1801




 





 





 





 





 





 



         if (my $table_field_node = $table_fields_by_row_field{$row_field_node->get_self_id()}) { 




1802




 





 





 





 





 





 



             my $mandatory = $table_field_node->get_attribute( 'mandatory' ); 




1803




 





 





 





 





 





 



             $mandatory and $mandatory_field_cache{$row_field_node->get_self_id()} = 1; 




1804




 





 





 





 





 





 



             my $default_val = $table_field_node->get_attribute( 'default_val' ); 




1805




 





 





 





 





 





 



             my $auto_inc = $table_field_node->get_attribute( 'auto_inc' ); 




1806




 





 





 





 





 





 



             my $default_seq_node = $table_field_node->get_attribute( 'default_seq' ); 




1807




 





 





 





 





 





 



             $table_field_sql_item .= ($mandatory ? ' NOT NULL' : ' NULL') 




1808




 





 





 





 





 





 



                 . (defined $default_val ? ' DEFAULT ' . $builder->quote_literal( 




1809




 





 





 





 





 





 



                     $default_val, $scalar_data_type_node->get_attribute( 'base_type' ) ) : $EMPTY_STR) 




1810




 





 





 





 





 





 



                 . ($auto_inc ? ' AUTO_INCREMENT' : $EMPTY_STR) 




1811




 





 





 





 





 





 



                 . ($default_seq_node ? ' DEFAULT ' 




1812




 





 





 





 





 





 



                     . $builder->build_expr_seq_next( $default_seq_node ) : $EMPTY_STR); 




1813




 





 





 





 





 





 



         } 




1814




 





 





 





 





 





 



         else { 




1815




 





 





 





 





 





 



             $table_field_sql_item .= ' NULL'; 




1816




 





 





 





 





 





 



         } 




1817




 





 





 





 





 





 



         push @table_field_sql, $table_field_sql_item; 




1818




 





 





 





 





 





 



     } 




1819




 





 





 





 





 





 



     my @table_index_sql = (); 




1820




 





 





 





 





 





 



     my $pk_is_made = 0; 




1821




 





 





 





 





 





 



     for my $table_index_node (@{$table_node->get_child_nodes( 'table_index' )}) { 




1822




 





 





 





 





 





 



         my $table_index_name = $builder->build_identifier_element( $table_index_node ); 




1823




 





 





 





 





 





 



         my $index_type = $table_index_node->get_attribute( 'index_type' ); 




1824




 





 





 





 





 





 



         my @table_index_field_nodes = @{$table_index_node->get_child_nodes( 'table_index_field' )}; 




1825




 





 





 





 





 





 



         my $local_field_names_sql = join q{, }, map { 




1826




 





 





 





 





 





 



                 $col_name_cache{$_->get_attribute( 'si_field' )->get_self_id()} 




1827




 





 





 





 





 





 



             } @table_index_field_nodes; 




1828




 





 





 





 





 





 



         if ($index_type eq 'ATOMIC') { 




1829




 





 





 





 





 





 



             push @table_index_sql, 'INDEX ' . $table_index_name . ' (' . $local_field_names_sql . ')'; 




1830




 





 





 





 





 





 



         } 




1831




 





 





 





 





 





 



         if ($index_type eq 'FULLTEXT') { 




1832




 





 





 





 





 





 



             push @table_index_sql, 'FULLTEXT INDEX ' . $table_index_name . ' (' . $local_field_names_sql . ')'; 




1833




 





 





 





 





 





 



         } 




1834




 





 





 





 





 





 



         if ($index_type eq 'UNIQUE' or $index_type eq 'UFOREIGN') { 




1835




 





 





 





 





 





 



             my $make_a_pk_now = 0; 




1836




 





 





 





 





 





 



             if (!$pk_is_made) { 




1837




 





 





 





 





 





 



                 # All component columns of a primary key must be mandatory; check for it. 




1838




 





 





 





 





 





 



                 $make_a_pk_now = all { 




1839




 





 





 





 





 





 



                         $mandatory_field_cache{ $_->get_attribute( 'si_field' )->get_self_id() } 




1840




 





 





 





 





 





 



                     } @table_index_field_nodes; 




1841




 





 





 





 





 





 



             } 




1842




 





 





 





 





 





 



             if ($make_a_pk_now) { 




1843




 





 





 





 





 





 



                 push @table_index_sql, 'CONSTRAINT PRIMARY KEY (' . $local_field_names_sql . ')'; 




1844




 





 





 





 





 





 



             } 




1845




 





 





 





 





 





 



             else { 




1846




 





 





 





 





 





 



                 push @table_index_sql, 'CONSTRAINT ' . $table_index_name . ' UNIQUE' 




1847




 





 





 





 





 





 



                     . ' (' . $local_field_names_sql . ')'; # standard does not say INDEX after UNIQUE 




1848




 





 





 





 





 





 



             } 




1849




 





 





 





 





 





 



         } 




1850




 





 





 





 





 





 



         if ($index_type eq 'FOREIGN' or $index_type eq 'UFOREIGN') { 




1851




 





 





 





 





 





 



             my $foreign_table_name = $builder->build_identifier_schema_or_app_obj( 




1852




 





 





 





 





 





 



                 $table_index_node->get_attribute( 'f_table' ) ); 




1853




 





 





 





 





 





 



             my $foreign_field_names_sql = join q{, }, map { 




1854




 





 





 





 





 





 



                     $builder->build_identifier_element( $_->get_attribute( 'f_field' ) ) 




1855




 





 





 





 





 





 



                 } @table_index_field_nodes; 




1856




 





 





 





 





 





 



             push @table_index_sql, 'CONSTRAINT ' . $table_index_name . ' FOREIGN KEY' 




1857




 





 





 





 





 





 



                 . ' (' . $local_field_names_sql . ') REFERENCES ' . $foreign_table_name 




1858




 





 





 





 





 





 



                 . ' (' . $foreign_field_names_sql . ')'; 




1859




 





 





 





 





 





 



         } 




1860




 





 





 





 





 





 



     } 




1861




 





 





 





 





 





 



     my $is_temp = ($table_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1862




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' TABLE ' . $table_name 




1863




 





 





 





 





 





 



            . ' (' . "\n" . (join q{, } . "\n", @table_field_sql, @table_index_sql) . "\n" . ');' . "\n"; 




1864




 





 





 





 





 





 



 } 




1865




 





 





 





 





 





 



   




1866




 





 





 





 





 





 



 sub build_schema_or_app_table_delete { # SQL:2003, 11.21 "" (p587) 




1867




 





 





 





 





 





 



     my ($builder, $table_node) = @_; 




1868




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_table_delete', 




1869




 





 





 





 





 





 



         'TABLE_NODE', ['table'], $table_node ); 




1870




 





 





 





 





 





 



     my $table_name = $builder->build_identifier_schema_or_app_obj( $table_node, 1 ); 




1871




 





 





 





 





 





 



     return 'DROP TABLE ' . $table_name . ';' . "\n"; 




1872




 





 





 





 





 





 



 } 




1873




 





 





 





 





 





 



   




1874




 





 





 





 





 





 



 ###################################################################### 




1875




 





 





 





 





 





 



   




1876




 





 





 





 





 





 



 sub build_schema_or_app_view_create { # SQL:2003, 11.22 "" (p590) 




1877




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1878




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_view_create', 




1879




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1880




 





 





 





 





 





 



     my $view_name = $builder->build_identifier_schema_or_app_obj( $view_node, 1 ); 




1881




 





 





 





 





 





 



     my $query_expression = $builder->build_query_query_expr( $view_node ); 




1882




 





 





 





 





 





 



     my $is_temp = ($view_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1883




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' VIEW ' . $view_name . ' AS ' . $query_expression . ';' . "\n"; 




1884




 





 





 





 





 





 



     # Note: Several interesting looking features are not implemented yet. 




1885




 





 





 





 





 





 



 } 




1886




 





 





 





 





 





 



   




1887




 





 





 





 





 





 



 sub build_schema_or_app_view_delete { # SQL:2003, 11.23 "" (p600) 




1888




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1889




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_view_delete', 




1890




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1891




 





 





 





 





 





 



     my $view_name = $builder->build_identifier_schema_or_app_obj( $view_node, 1 ); 




1892




 





 





 





 





 





 



     return 'DROP VIEW ' . $view_name . ';' . "\n"; 




1893




 





 





 





 





 





 



 } 




1894




 





 





 





 





 





 



   




1895




 





 





 





 





 





 



 ###################################################################### 




1896




 





 





 





 





 





 



   




1897




 





 





 





 





 





 



 sub build_schema_or_app_routine_create { 




1898




 





 





 





 





 





 



     # SQL:2003, 11.39 "" (p629) 




1899




 





 





 





 





 





 



     # SQL:2003, 11.50 "" (p675) 




1900




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




1901




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_routine_create', 




1902




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




1903




 





 





 





 





 





 



     my $routine_type = $routine_node->get_attribute( 'routine_type' ); 




1904




 





 





 





 





 





 



     my $routine_name = $builder->build_identifier_schema_or_app_obj( $routine_node, 1 ); 




1905




 





 





 





 





 





 



     my $is_temp = ($routine_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1906




 





 





 





 





 





 



     if ($routine_type eq 'PACKAGE') { 




1907




 





 





 





 





 





 



         # Not implemented yet. 




1908




 





 





 





 





 





 



     } 




1909




 





 





 





 





 





 



     elsif ($routine_type eq 'TRIGGER') { 




1910




 





 





 





 





 





 



         my $table_or_view_name = $builder->build_identifier_schema_or_app_obj( 




1911




 





 





 





 





 





 



             $routine_node->get_attribute( 'trigger_on' ) ); 




1912




 





 





 





 





 





 



         my $trigger_event = $routine_node->get_attribute( 'trigger_event' ); 




1913




 





 





 





 





 





 



         my $trigger_event_sql 




1914




 





 





 





 





 





 



             = $trigger_event eq 'BEFR_INS' ? 'BEFORE INSERT' 




1915




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_INS' ? 'AFTER INSERT' 




1916




 





 





 





 





 





 



             : $trigger_event eq 'INST_INS' ? 'INSTEAD OF INSERT' 




1917




 





 





 





 





 





 



             : $trigger_event eq 'BEFR_UPD' ? 'BEFORE UPDATE' 




1918




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_UPD' ? 'AFTER UPDATE' 




1919




 





 





 





 





 





 



             : $trigger_event eq 'INST_UPD' ? 'INSTEAD OF UPDATE' 




1920




 





 





 





 





 





 



             : $trigger_event eq 'BEFR_DEL' ? 'BEFORE DELETE' 




1921




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_DEL' ? 'AFTER DELETE' 




1922




 





 





 





 





 





 



             : $trigger_event eq 'INST_DEL' ? 'INSTEAD OF DELETE' 




1923




 





 





 





 





 





 



             :                                undef # we should never get here 




1924




 





 





 





 





 





 



             ; 




1925




 





 





 





 





 





 



             # Note: INSTEAD OF is not standard SQL, but supported by SQLServer 2000, maybe Oracle, ?. 




1926




 





 





 





 





 





 



         my $for_each_stmt = $routine_node->get_attribute( 'trigger_per_stmt' ); 




1927




 





 





 





 





 





 



         # TODO: Implement optional OF . 




1928




 





 





 





 





 





 



         my @transition_var_names = (); # TODO: NEW/OLD ROW AS <... variable name> 




1929




 





 





 





 





 





 



         my $triggered_sql_statement = $builder->build_dmanip_routine_body( $routine_node, 1 ); 




1930




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' TRIGGER ' . $routine_name . ' ' 




1931




 





 





 





 





 





 



             . $trigger_event_sql . ' ON ' . $table_or_view_name 




1932




 





 





 





 





 





 



             . (@transition_var_names ? ' REFERENCING ' . (join ' ', @transition_var_names) : $EMPTY_STR) 




1933




 





 





 





 





 





 



             . ($for_each_stmt ? ' FOR EACH STATEMENT' : ' FOR EACH ROW') 




1934




 





 





 





 





 





 



             # TODO: WHEN (  ) 




1935




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1936




 





 





 





 





 





 



             . $triggered_sql_statement 




1937




 





 





 





 





 





 



             . ';' . "\n"; 




1938




 





 





 





 





 





 



     } 




1939




 





 





 





 





 





 



     elsif ($routine_type eq 'PROCEDURE') { 




1940




 





 





 





 





 





 



         my $routine_args = $builder->build_dmanip_routine_args( $routine_node ); 




1941




 





 





 





 





 





 



         # TODO:  where appropriate. 




1942




 





 





 





 





 





 



         my $routine_body = $builder->build_dmanip_routine_body( $routine_node ); 




1943




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' PROCEDURE ' . $routine_name 




1944




 





 





 





 





 





 



             . $routine_args 




1945




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1946




 





 





 





 





 





 



             . ' ' . $routine_body . ';' . "\n"; 




1947




 





 





 





 





 





 



     } 




1948




 





 





 





 





 





 



     elsif ($routine_type eq 'FUNCTION') { 




1949




 





 





 





 





 





 



         my $routine_args = $builder->build_dmanip_routine_args( $routine_node ); 




1950




 





 





 





 





 





 



         # TODO:  where appropriate. 




1951




 





 





 





 





 





 



         my $routine_body = $builder->build_dmanip_routine_body( $routine_node ); 




1952




 





 





 





 





 





 



         my $return_cont_type = $routine_node->get_attribute( 'return_cont_type' ); 




1953




 





 





 





 





 





 



         my $return_data_type = $EMPTY_STR; 




1954




 





 





 





 





 





 



         if ($return_cont_type eq 'ERROR') { 




1955




 





 





 





 





 





 



             # Not implemented yet. 




1956




 





 





 





 





 





 



         } 




1957




 





 





 





 





 





 



         elsif ($return_cont_type eq 'SCALAR') { 




1958




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_scalar_data_type' ); 




1959




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




1960




 





 





 





 





 





 



         } 




1961




 





 





 





 





 





 



         elsif ($return_cont_type eq 'ROW') { 




1962




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_row_data_type' ); 




1963




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




1964




 





 





 





 





 





 



         } 




1965




 





 





 





 





 





 



         elsif ($return_cont_type eq 'SC_ARY') { 




1966




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_scalar_data_type' ); 




1967




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ) . ' ARRAY'; 




1968




 





 





 





 





 





 



         } 




1969




 





 





 





 





 





 



         elsif ($return_cont_type eq 'RW_ARY') { 




1970




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_row_data_type' ); 




1971




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ) . ' ARRAY'; 




1972




 





 





 





 





 





 



         } 




1973




 





 





 





 





 





 



         elsif ($return_cont_type eq 'CONN') { 




1974




 





 





 





 





 





 



             # Not implemented yet. 




1975




 





 





 





 





 





 



         } 




1976




 





 





 





 





 





 



         elsif ($return_cont_type eq 'CURSOR') { 




1977




 





 





 





 





 





 



             # Not implemented yet. 




1978




 





 





 





 





 





 



         } 




1979




 





 





 





 





 





 



         elsif ($return_cont_type eq 'LIST') { 




1980




 





 





 





 





 





 



             # Not implemented yet. 




1981




 





 





 





 





 





 



         } 




1982




 





 





 





 





 





 



         else {} 




1983




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' FUNCTION ' . $routine_name 




1984




 





 





 





 





 





 



             . $routine_args 




1985




 





 





 





 





 





 



             . ' RETURNS ' . $return_data_type 




1986




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1987




 





 





 





 





 





 



             . ' ' . $routine_body . ';' . "\n"; 




1988




 





 





 





 





 





 



     } 




1989




 





 





 





 





 





 



     else {} # $routine_type eq 'BLOCK' 




1990




 





 





 





 





 





 



         # 'BLOCK': no-op; you should call build_dmanip_routine_body() directly instead 




1991




 





 





 





 





 





 



 } 




1992




 





 





 





 





 





 



   




1993




 





 





 





 





 





 



 sub build_schema_or_app_routine_delete { 




1994




 





 





 





 





 





 



     # SQL:2003, 11.40 "" (p633) 




1995




 





 





 





 





 





 



     # SQL:2003, 11.52 "" (p703) 




1996




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




1997




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_routine_delete', 




1998




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




1999




 





 





 





 





 





 



     my $routine_type = $routine_node->get_attribute( 'routine_type' ); 




2000




 





 





 





 





 





 



     my $routine_name = $builder->build_identifier_schema_or_app_obj( $routine_node, 1 ); 




2001




 





 





 





 





 





 



     # Note: 10.6 "" (p499) may be useful later. 




2002




 





 





 





 





 





 



     if ($routine_type eq 'PACKAGE') { 




2003




 





 





 





 





 





 



         # Not implemented yet. 




2004




 





 





 





 





 





 



     } 




2005




 





 





 





 





 





 



     elsif ($routine_type eq 'TRIGGER') { 




2006




 





 





 





 





 





 



         return 'DROP TRIGGER ' . $routine_name . ';' . "\n"; 




2007




 





 





 





 





 





 



     } 




2008




 





 





 





 





 





 



     elsif ($routine_type eq 'PROCEDURE') { 




2009




 





 





 





 





 





 



         return 'DROP PROCEDURE ' . $routine_name . ';' . "\n"; 




2010




 





 





 





 





 





 



     } 




2011




 





 





 





 





 





 



     elsif ($routine_type eq 'FUNCTION') { 




2012




 





 





 





 





 





 



         return 'DROP FUNCTION ' . $routine_name . ';' . "\n"; 




2013




 





 





 





 





 





 



     } 




2014




 





 





 





 





 





 



     else {} # $routine_type eq 'BLOCK'; no-op 




2015




 





 





 





 





 





 



 } 




2016




 





 





 





 





 





 



   




2017




 





 





 





 





 





 



 ###################################################################### 




2018




 





 





 





 





 





 



   




2019




 





 





 





 





 





 



 sub build_access_role_create { # SQL:2003, 12.4 "" (p743) 




2020




 





 





 





 





 





 



     my ($builder, $role_node) = @_; 




2021




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_role_create', 




2022




 





 





 





 





 





 



         'ROLE_NODE', ['role'], $role_node ); 




2023




 





 





 





 





 





 



     my $role_name = $builder->build_identifier_element( $role_node ); 




2024




 





 





 





 





 





 



     return 'CREATE ROLE ' . $role_name . ';' . "\n"; 




2025




 





 





 





 





 





 



 } 




2026




 





 





 





 





 





 



   




2027




 





 





 





 





 





 



 sub build_access_role_delete { # SQL:2003, 12.6 "" (p746) 




2028




 





 





 





 





 





 



     my ($builder, $role_node) = @_; 




2029




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_role_delete', 




2030




 





 





 





 





 





 



         'ROLE_NODE', ['role'], $role_node ); 




2031




 





 





 





 





 





 



     my $role_name = $builder->build_identifier_element( $role_node ); 




2032




 





 





 





 





 





 



     return 'DROP ROLE ' . $role_name . ';' . "\n"; 




2033




 





 





 





 





 





 



 } 




2034




 





 





 





 





 





 



   




2035




 





 





 





 





 





 



 ###################################################################### 




2036




 





 





 





 





 





 



   




2037




 





 





 





 





 





 



 sub build_access_grant { 




2038




 





 





 





 





 





 



     # Function returns empty string if given grantee has no privileges. 




2039




 





 





 





 





 





 



     # SQL:2003, 12.1 "" (p731) 




2040




 





 





 





 





 





 



     # SQL:2003, 12.2 "" (p736) 




2041




 





 





 





 





 





 



     # SQL:2003, 12.3 "" (p739) 




2042




 





 





 





 





 





 



     # SQL:2003, 12.5 "" (p744) 




2043




 





 





 





 





 





 



     my ($builder, $grantee_node) = @_; 




2044




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_grant', 




2045




 





 





 





 





 





 



         'GRANTEE_NODE', ['role','user'], $grantee_node ); 




2046




 





 





 





 





 





 



     my $node_type = $grantee_node->get_node_type(); 




2047




 





 





 





 





 





 



     my $grantee_name = $builder->build_identifier_schema_or_app_obj( $grantee_node ); 




2048




 





 





 





 





 





 



     if ($node_type eq 'role') { 




2049




 





 





 





 





 





 



         my @grant_stmts = (); 




2050




 





 





 





 





 





 



         for my $priv_on_node (@{$grantee_node->get_child_nodes( 'privilege_on' )}) { 




2051




 





 





 





 





 





 



             my $object_node = $priv_on_node->get_attribute( 'si_priv_on' ); 




2052




 





 





 





 





 





 



             my $object_name = $builder->build_identifier_schema_or_app_obj( $object_node ); 




2053




 





 





 





 





 





 



             my @priv_types = map { $_->get_attribute( 'si_priv_type' ) } 




2054




 





 





 





 





 





 



                 @{$priv_on_node->get_child_nodes( 'privilege_for' )}; 




2055




 





 





 





 





 





 



             my @object_privs = (); 




2056




 





 





 





 





 





 



             if (grep { $_ eq 'ALL' } @priv_types) { 




2057




 





 





 





 





 





 



                 push @object_privs, 'ALL PRIVILEGES'; 




2058




 





 





 





 





 





 



             } 




2059




 





 





 





 





 





 



             else { 




2060




 





 





 





 





 





 



                 for my $priv_type (@priv_types) { 




2061




 





 





 





 





 





 



                     push @object_privs, 




2062




 





 





 





 





 





 



                            $priv_type eq 'SELECT' ? 'SELECT' # TODO: allow only specific columns 




2063




 





 





 





 





 





 



                          : $priv_type eq 'DELETE' ? 'DELETE' 




2064




 





 





 





 





 





 



                          : $priv_type eq 'INSERT' ? 'INSERT' # TODO: allow only specific columns 




2065




 





 





 





 





 





 



                          : $priv_type eq 'UPDATE' ? 'UPDATE' # TODO: allow only specific columns 




2066




 





 





 





 





 





 



                          :                          $EMPTY_STR # TODO: REFERENCES, USAGE, TRIGGER, UNDER, EXECUTE; what do they mean? 




2067




 





 





 





 





 





 



                          ; 




2068




 





 





 





 





 





 



                 } 




2069




 





 





 





 





 





 



             } 




2070




 





 





 





 





 





 



             push @grant_stmts, 'GRANT ' . (join q{, }, @object_privs) 




2071




 





 





 





 





 





 



                 . ' ON ' . $object_name . ' TO ' . $grantee_name . ';'; 




2072




 





 





 





 





 





 



         } 




2073




 





 





 





 





 





 



         return join $EMPTY_STR, @grant_stmts; 




2074




 





 





 





 





 





 



     } 




2075




 





 





 





 





 





 



     elsif ($node_type eq 'user') { 




2076




 





 





 





 





 





 



         my @role_names = map { $builder->build_identifier_schema_or_app_obj( $_ ) } 




2077




 





 





 





 





 





 



             @{$grantee_node->get_child_nodes( 'user_role' )}; 




2078




 





 





 





 





 





 



         return @role_names ? 'GRANT ' . (join q{, }, @role_names) . ' TO ' . $grantee_name . ';' : $EMPTY_STR; 




2079




 





 





 





 





 





 



     } 




2080




 





 





 





 





 





 



     else {} 




2081




 





 





 





 





 





 



 } 




2082




 





 





 





 





 





 



   




2083




 





 





 





 





 





 



 sub build_access_revoke { 




2084




 





 





 





 





 





 



     # SQL:2003, 12.7 "" (p747) 




2085




 





 





 





 





 





 



     # SQL:2003, 12.3 "" (p739) 




2086




 





 





 





 





 





 



     my ($builder, $grantee_node) = @_; 




2087




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_revoke', 




2088




 





 





 





 





 





 



         'GRANTEE_NODE', ['role','user'], $grantee_node ); 




2089




 





 





 





 





 





 



     my $node_type = $grantee_node->get_node_type(); 




2090




 





 





 





 





 





 



     my $grantee_name = $builder->build_identifier_schema_or_app_obj( $grantee_node ); 




2091




 





 





 





 





 





 



     if ($node_type eq 'role') { 




2092




 





 





 





 





 





 



         my @revoke_stmts = (); 




2093




 





 





 





 





 





 



         for my $priv_on_node (@{$grantee_node->get_child_nodes( 'privilege_on' )}) { 




2094




 





 





 





 





 





 



             my $object_node = $priv_on_node->get_attribute( 'si_priv_on' ); 




2095




 





 





 





 





 





 



             my $object_name = $builder->build_identifier_schema_or_app_obj( $object_node ); 




2096




 





 





 





 





 





 



             push @revoke_stmts, 'REVOKE ALL PRIVILEGES' 




2097




 





 





 





 





 





 



                 . ' ON ' . $object_name . ' FROM ' . $grantee_name . ';'; 




2098




 





 





 





 





 





 



         } 




2099




 





 





 





 





 





 



         return join $EMPTY_STR, @revoke_stmts; 




2100




 





 





 





 





 





 



     } 




2101




 





 





 





 





 





 



     elsif ($node_type eq 'user') { 




2102




 





 





 





 





 





 



         my @role_names = map { $builder->build_identifier_schema_or_app_obj( $_ ) } 




2103




 





 





 





 





 





 



             @{$grantee_node->get_child_nodes( 'user_role' )}; 




2104




 





 





 





 





 





 



         return @role_names ? 'REVOKE ' . (join q{, }, @role_names) . ' FROM ' . $grantee_name . ';' : $EMPTY_STR; 




2105




 





 





 





 





 





 



     } 




2106




 





 





 





 





 





 



     else {} 




2107




 





 





 





 





 





 



 } 




2108




 





 





 





 





 





 



   




2109




 





 





 





 





 





 



 ###################################################################### 




2110




 





 





 





 





 





 



   




2111




 





 





 





 





 





 



 sub build_dmanip_routine_args { 




2112




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




2113




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_args', 




2114




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




2115




 





 





 





 





 





 



     # SQL:2003, 11.50 "" (p675) 




2116




 





 





 





 





 





 



     # in particular see  




2117




 





 





 





 





 





 



     my @rtn_arg_declare_sql = (); 




2118




 





 





 





 





 





 



     for my $rtn_arg_node (@{$routine_node->get_child_nodes( 'routine_arg' )}) { 




2119




 





 





 





 





 





 



         # TODO:  ::= IN | OUT | INOUT 




2120




 





 





 





 





 





 



         my $arg_name = $builder->build_identifier_element( $rtn_arg_node ); 




2121




 





 





 





 





 





 



         my $cont_type = $rtn_arg_node->get_attribute( 'cont_type' ); 




2122




 





 





 





 





 





 



         if ($cont_type eq 'ERROR') { 




2123




 





 





 





 





 





 



             # Not implemented yet. 




2124




 





 





 





 





 





 



         } 




2125




 





 





 





 





 





 



         elsif ($cont_type eq 'SCALAR') { 




2126




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'scalar_data_type' ); 




2127




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2128




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ';'; 




2129




 





 





 





 





 





 



         } 




2130




 





 





 





 





 





 



         elsif ($cont_type eq 'ROW') { 




2131




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'row_data_type' ); 




2132




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2133




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ';'; 




2134




 





 





 





 





 





 



         } 




2135




 





 





 





 





 





 



         elsif ($cont_type eq 'SC_ARY') { 




2136




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'scalar_data_type' ); 




2137




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2138




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2139




 





 





 





 





 





 



         } 




2140




 





 





 





 





 





 



         elsif ($cont_type eq 'RW_ARY') { 




2141




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'row_data_type' ); 




2142




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2143




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2144




 





 





 





 





 





 



         } 




2145




 





 





 





 





 





 



         elsif ($cont_type eq 'CONN') { 




2146




 





 





 





 





 





 



             # Not implemented yet. 




2147




 





 





 





 





 





 



         } 




2148




 





 





 





 





 





 



         elsif ($cont_type eq 'CURSOR') { 




2149




 





 





 





 





 





 



             # Not implemented yet. 




2150




 





 





 





 





 





 



         } 




2151




 





 





 





 





 





 



         elsif ($cont_type eq 'LIST') { 




2152




 





 





 





 





 





 



             # Not implemented yet. 




2153




 





 





 





 





 





 



         } 




2154




 





 





 





 





 





 



         else {} 




2155




 





 





 





 





 





 



     } 




2156




 





 





 





 





 





 



     return @rtn_arg_declare_sql ? '(' . (join q{, }, @rtn_arg_declare_sql) . ')' : $EMPTY_STR; 




2157




 





 





 





 





 





 



 } 




2158




 





 





 





 





 





 



   




2159




 





 





 





 





 





 



 sub build_dmanip_routine_body { 




2160




 





 





 





 





 





 



     # Corresponds to these sections: 




2161




 





 





 





 





 





 



     # ? 




2162




 





 





 





 





 





 



     # SQL:2003, 6.1 "" (p161) 




2163




 





 





 





 





 





 



     # SQL:2003, 13.5 "" (p790) 




2164




 





 





 





 





 





 



     # SQL:2003, 14.1 "" (p809) 




2165




 





 





 





 





 





 



     my ($builder, $routine_node, $is_atomic) = @_; 




2166




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_body', 




2167




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




2168




 





 





 





 





 





 



     my $is_ora_routines = $builder->{$PROP_ORA_ROUTINES}; 




2169




 





 





 





 





 





 



     my @rtn_var_declare_sql = (); 




2170




 





 





 





 





 





 



     for my $rtn_var_node (@{$routine_node->get_child_nodes( 'routine_var' )}) { 




2171




 





 





 





 





 





 



         my $var_name = $builder->build_identifier_element( $rtn_var_node ); 




2172




 





 





 





 





 





 



         my $cont_type = $rtn_var_node->get_attribute( 'cont_type' ); 




2173




 





 





 





 





 





 



         if ($cont_type eq 'ERROR') { 




2174




 





 





 





 





 





 



             # Not implemented yet. 




2175




 





 





 





 





 





 



         } 




2176




 





 





 





 





 





 



         elsif ($cont_type eq 'SCALAR') { 




2177




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'scalar_data_type' ); 




2178




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2179




 





 





 





 





 





 



             my $init_lit_val = $rtn_var_node->get_attribute( 'init_lit_val' ); 




2180




 





 





 





 





 





 



             my $is_constant = $rtn_var_node->get_attribute( 'is_constant' ); 




2181




 





 





 





 





 





 



             push @rtn_var_declare_sql, 




2182




 





 





 





 





 





 



                 ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') 




2183




 





 





 





 





 





 



                 . $var_name . ' ' . $dt_or_dom_sql 




2184




 





 





 





 





 





 



                 # TODO: use $is_constant 




2185




 





 





 





 





 





 



                 . (defined $init_lit_val ? ' DEFAULT ' . $builder->quote_literal( $init_lit_val, 




2186




 





 





 





 





 





 



                     $builder->_scalar_data_type_of_node( $rtn_var_node )->get_attribute( 'base_type' ) ) : $EMPTY_STR) 




2187




 





 





 





 





 





 



                 . ';' 




2188




 





 





 





 





 





 



             ; 




2189




 





 





 





 





 





 



         } 




2190




 





 





 





 





 





 



         elsif ($cont_type eq 'ROW') { 




2191




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'row_data_type' ); 




2192




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2193




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ';'; 




2194




 





 





 





 





 





 



         } 




2195




 





 





 





 





 





 



         elsif ($cont_type eq 'SC_ARY') { 




2196




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'scalar_data_type' ); 




2197




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2198




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2199




 





 





 





 





 





 



         } 




2200




 





 





 





 





 





 



         elsif ($cont_type eq 'RW_ARY') { 




2201




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'row_data_type' ); 




2202




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2203




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2204




 





 





 





 





 





 



         } 




2205




 





 





 





 





 





 



         elsif ($cont_type eq 'CONN') { 




2206




 





 





 





 





 





 



             # Not implemented yet. 




2207




 





 





 





 





 





 



         } 




2208




 





 





 





 





 





 



         elsif ($cont_type eq 'CURSOR') { 




2209




 





 





 





 





 





 



             if (my $view_node = (@{$rtn_var_node->get_child_nodes( 'view' )})[0]) { 




2210




 





 





 





 





 





 



                 # Since we got here, cursor will be defined within curr rtn, regardless of share or not. 




2211




 





 





 





 





 





 



                 my $query_expr = $builder->build_query_query_expr( $view_node ); 




2212




 





 





 





 





 





 



                 my $order_by_clause = $builder->build_query_window_clause( $view_node ); 




2213




 





 





 





 





 





 



                 my $updatability_clause 




2214




 





 





 





 





 





 



                     = $rtn_var_node->get_attribute( 'curs_for_update' ) ? 'FOR UPDATE' 




2215




 





 





 





 





 





 



                     :                                                     'FOR READ ONLY'; # TODO: [ OF  ] 




2216




 





 





 





 





 





 



                 # TODO: sensitivity, scrollability, holdability, returnability 




2217




 





 





 





 





 





 



                 my $cursor_spec = $query_expr . ' ' . $order_by_clause . ' ' . $updatability_clause; 




2218




 





 





 





 





 





 



                 push @rtn_var_declare_sql, 'DECLARE ' . $var_name . ' CURSOR FOR ' . $cursor_spec . ';'; 




2219




 





 





 





 





 





 



             } 




2220




 





 





 





 





 





 



             else { 




2221




 





 





 





 





 





 



                 # Not implemented yet; but also not sure of proper way to implement. 




2222




 





 





 





 





 





 



                 # If we got here then cursor had been declared in diff rtn and passed to curr one. 




2223




 





 





 





 





 





 



                 # We can't just make another copy of decl since may use vars/args/etc of other rtn. 




2224




 





 





 





 





 





 



                 push @rtn_var_declare_sql, 'DECLARE ' . $var_name . ';'; 




2225




 





 





 





 





 





 



             } 




2226




 





 





 





 





 





 



         } 




2227




 





 





 





 





 





 



         elsif ($cont_type eq 'LIST') { 




2228




 





 





 





 





 





 



             # Not implemented yet. 




2229




 





 





 





 





 





 



         } 




2230




 





 





 





 





 





 



         else {} 




2231




 





 





 





 





 





 



     } 




2232




 





 





 





 





 





 



     my @rtn_stmt_sql = (); 




2233




 





 





 





 





 





 



     for my $rtn_stmt_node (@{$routine_node->get_child_nodes( 'routine_stmt' )}) { 




2234




 





 





 





 





 





 



         push @rtn_stmt_sql, $builder->build_dmanip_routine_stmt( $rtn_stmt_node ); 




2235




 





 





 





 





 





 



     } 




2236




 





 





 





 





 





 



     my $atomic_clause = $is_atomic ? 'ATOMIC ' : $EMPTY_STR; 




2237




 





 





 





 





 





 



     return join ' ', 




2238




 





 





 





 





 





 



         # TODO: proper handling of vars declared within 'BLOCK' routines, when in Oracle syntax. 




2239




 





 





 





 





 





 



         ($is_ora_routines ? 'VAR ' : 'BEGIN ' . $atomic_clause), 




2240




 





 





 





 





 





 



         @rtn_var_declare_sql, 




2241




 





 





 





 





 





 



         ($is_ora_routines ? 'BEGIN ' . $atomic_clause : $EMPTY_STR), 




2242




 





 





 





 





 





 



         @rtn_stmt_sql, 




2243




 





 





 





 





 





 



         'END;' 




2244




 





 





 





 





 





 



     ; 




2245




 





 





 





 





 





 



 } 




2246




 





 





 





 





 





 



   




2247




 





 





 





 





 





 



 ###################################################################### 




2248




 





 





 





 





 





 



   




2249




 





 





 





 





 





 



 sub build_dmanip_routine_stmt { 




2250




 





 





 





 





 





 



     # SQL:2003, 13.5 "" (p790) 




2251




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2252




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_stmt', 




2253




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2254




 





 





 





 





 





 



     if (my $compound_stmt_routine = $rtn_stmt_node->get_attribute( 'block_routine' )) { 




2255




 





 





 





 





 





 



         return $builder->build_dmanip_routine_body( $compound_stmt_routine ); 




2256




 





 





 





 





 





 



     } 




2257




 





 





 





 





 





 



     elsif (my $assign_dest_node = $rtn_stmt_node->get_attribute( 'assign_dest' ) || 




2258




 





 





 





 





 





 



             $rtn_stmt_node->get_attribute( 'assign_dest' )) { 




2259




 





 





 





 





 





 



         my $dest = $builder->build_identifier_element( $assign_dest_node ); 




2260




 





 





 





 





 





 



         my $src = $builder->build_expr( 




2261




 





 





 





 





 





 



             $rtn_stmt_node->get_child_nodes( 'routine_expr' )->[0] ); 




2262




 





 





 





 





 





 



         if ($builder->{$PROP_ORA_ROUTINES}) { 




2263




 





 





 





 





 





 



             return $dest . ' := ' . $src . ';' . "\n"; 




2264




 





 





 





 





 





 



         } 




2265




 





 





 





 





 





 



         else { 




2266




 





 





 





 





 





 



             return 'SET ' . $dest . ' = ' . $src . ';' . "\n"; 




2267




 





 





 





 





 





 



         } 




2268




 





 





 





 





 





 



     } 




2269




 





 





 





 





 





 



     elsif ($rtn_stmt_node->get_attribute( 'call_sroutine' )) { 




2270




 





 





 





 





 





 



         return $builder->build_dmanip_call_sroutine( $rtn_stmt_node ); 




2271




 





 





 





 





 





 



     } 




2272




 





 





 





 





 





 



     elsif ($rtn_stmt_node->get_attribute( 'call_uroutine' )) { 




2273




 





 





 





 





 





 



         return $builder->build_dmanip_call_uroutine( $rtn_stmt_node ); 




2274




 





 





 





 





 





 



     } 




2275




 





 





 





 





 





 



     else {} 




2276




 





 





 





 





 





 



 } 




2277




 





 





 





 





 





 



   




2278




 





 





 





 





 





 



 ###################################################################### 




2279




 





 





 





 





 





 



   




2280




 





 





 





 





 





 



 sub build_dmanip_call_sroutine { 




2281




 





 





 





 





 





 



     # Corresponds to these sections: 




2282




 





 





 





 





 





 



     # SQL:2003, 14.2 "" (p815) 




2283




 





 





 





 





 





 



     # SQL:2003, 14.3 "" (p817) 




2284




 





 





 





 





 





 



     # SQL:2003, 14.4 "" (p822) 




2285




 





 





 





 





 





 



     # SQL:2003, 15.2 "" (p886) 




2286




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2287




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_call_sroutine', 




2288




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2289




 





 





 





 





 





 



     my $sroutine = $rtn_stmt_node->get_attribute( 'call_sroutine' ); 




2290




 





 





 





 





 





 



     my %child_exprs = map { ( 




2291




 





 





 





 





 





 



             ($_->get_attribute( 'call_sroutine_cxt' ) || 




2292




 





 





 





 





 





 



                 $_->get_attribute( 'call_sroutine_arg' )) => $_ 




2293




 





 





 





 





 





 



         ) } @{$rtn_stmt_node->get_child_nodes( 'routine_expr' )}; 




2294




 





 





 





 





 





 



     if ($sroutine eq 'RETURN') { 




2295




 





 





 





 





 





 



         my $return_value = $builder->build_expr( $child_exprs{'RETURN_VALUE'} ); 




2296




 





 





 





 





 





 



         return 'RETURN ' . $return_value . ';' . "\n"; # no parens in standard 




2297




 





 





 





 





 





 



     } 




2298




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_OPEN') { # opens a select cursor for reading from (or performs a select if in right context) 




2299




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2300




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2301




 





 





 





 





 





 



         return 'OPEN ' . $cursor_cx_name . ';' . "\n"; 




2302




 





 





 





 





 





 



     } 




2303




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_CLOSE') { # closes a select cursor when you're done with it 




2304




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2305




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2306




 





 





 





 





 





 



         return 'CLOSE ' . $cursor_cx_name . ';' . "\n"; 




2307




 





 





 





 





 





 



     } 




2308




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_FETCH') { # reads a row from an opened cursor and puts it in a row/list variable 




2309




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2310




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2311




 





 





 





 





 





 



         my $fetch_orient = $EMPTY_STR; # TODO: the explicit  options; NEXT is default 




2312




 





 





 





 





 





 



         my $query_dest_name = $builder->build_identifier_element( 




2313




 





 





 





 





 





 



             $child_exprs{'INTO'}->get_attribute( 'query_dest' ) ); 




2314




 





 





 





 





 





 



         return 'FETCH ' . $fetch_orient . ' FROM ' . $cursor_cx_name . ' INTO ' . $query_dest_name . ';' . "\n"; 




2315




 





 





 





 





 





 



     } 




2316




 





 





 





 





 





 



     elsif ($sroutine eq 'SELECT') { # fetches one row from a table/view and puts it in a row/list variable 




2317




 





 





 





 





 





 



         my $view_node = $child_exprs{'SELECT_DEFN'}->get_attribute( 'act_on' ); 




2318




 





 





 





 





 





 



         return $builder->build_query_query_spec( $view_node, 




2319




 





 





 





 





 





 



             $child_exprs{'INTO'}->get_attribute( 'query_dest' ) ) . ';' . "\n"; 




2320




 





 





 





 





 





 



     } 




2321




 





 





 





 





 





 



     elsif ($sroutine eq 'INSERT') { # inserts a row into a table/view 




2322




 





 





 





 





 





 



         my $view_node = $child_exprs{'INSERT_DEFN'}->get_attribute( 'act_on' ); 




2323




 





 





 





 





 





 



         return $builder->build_dmanip_insert_stmt( $view_node ); 




2324




 





 





 





 





 





 



     } 




2325




 





 





 





 





 





 



     elsif ($sroutine eq 'UPDATE') { # updates a row in a table/view 




2326




 





 





 





 





 





 



         my $view_node = $child_exprs{'UPDATE_DEFN'}->get_attribute( 'act_on' ); 




2327




 





 





 





 





 





 



         return $builder->build_dmanip_update_stmt( $view_node ); 




2328




 





 





 





 





 





 



     } 




2329




 





 





 





 





 





 



     elsif ($sroutine eq 'DELETE') { # deletes a row in a table/view 




2330




 





 





 





 





 





 



         my $view_node = $child_exprs{'DELETE_DEFN'}->get_attribute( 'act_on' ); 




2331




 





 





 





 





 





 



         return $builder->build_dmanip_delete_stmt( $view_node ); 




2332




 





 





 





 





 





 



     } 




2333




 





 





 





 





 





 



     elsif ($sroutine eq 'COMMIT') { # commits the current transaction, then starts a new one 




2334




 





 





 





 





 





 



         return 'COMMIT; START TRANSACTION;' . "\n"; 




2335




 





 





 





 





 





 



         # Note: According to the MySQL manual: 




2336




 





 





 





 





 





 



         # For transaction-safe tables, there are actions (other than typing COMMIT) 




2337




 





 





 





 





 





 



         # that will automatically trigger a COMMIT. Requesting a lock will implicitly 




2338




 





 





 





 





 





 



         # commit any outstanding queries. 




2339




 





 





 





 





 





 



     } 




2340




 





 





 





 





 





 



     elsif ($sroutine eq 'ROLLBACK') { # rolls back the current transaction, then starts a new one 




2341




 





 





 





 





 





 



         return 'ROLLBACK; START TRANSACTION;' . "\n"; # TODO: rollback to a named save point only 




2342




 





 





 





 





 





 



     } 




2343




 





 





 





 





 





 



     else {} # There are a bunch more that aren't implemented yet. 




2344




 





 





 





 





 





 



 } 




2345




 





 





 





 





 





 



   




2346




 





 





 





 





 





 



 ###################################################################### 




2347




 





 





 





 





 





 



   




2348




 





 





 





 





 





 



 sub build_dmanip_src_schema_object_name { 




2349




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2350




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_src_schema_object_name', 




2351




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2352




 





 





 





 





 





 



     my $view_type = $view_node->get_attribute( 'view_type' ); 




2353




 





 





 





 





 





 



     my @view_src_nodes = @{$view_node->get_child_nodes( 'view_src' )}; 




2354




 





 





 





 





 





 



     if (@view_src_nodes == 0) { 




2355




 





 





 





 





 





 



         return; # No source at all. 




2356




 





 





 





 





 





 



     } 




2357




 





 





 





 





 





 



     elsif ($view_type eq 'ALIAS' or @view_src_nodes == 1) { 




2358




 





 





 





 





 





 



         my $object_node = $view_src_nodes[0]->get_attribute( 'match' ); 




2359




 





 





 





 





 





 



         if ($object_node->get_primary_parent_attribute()->get_node_type() eq 'schema') { 




2360




 





 





 





 





 





 



             # The only source is a schema object, table or named view; use it directly. 




2361




 





 





 





 





 





 



             return $builder->build_identifier_schema_or_app_obj( $object_node ); 




2362




 





 





 





 





 





 



         } 




2363




 





 





 





 





 





 



         else { 




2364




 





 





 





 





 





 



             # The only source seems to be a sub-query in "from". 




2365




 





 





 





 





 





 



             return; # Adding recursion in all necessary places too complicated for now. 




2366




 





 





 





 





 





 



         } 




2367




 





 





 





 





 





 



     } 




2368




 





 





 





 





 





 



     else { # @view_src_nodes >= 2 




2369




 





 





 





 





 





 



         return; # Manual updates against multiple sources too complicated for now. 




2370




 





 





 





 





 





 



     } 




2371




 





 





 





 





 





 



 } 




2372




 





 





 





 





 





 



   




2373




 





 





 





 





 





 



 ###################################################################### 




2374




 





 





 





 





 





 



   




2375




 





 





 





 





 





 



 sub build_dmanip_insert_stmt { 




2376




 





 





 





 





 





 



     # SQL:2003, 7.3 "" (p298) 




2377




 





 





 





 





 





 



     # SQL:2003, 14.8 "" (p834) 




2378




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2379




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_insert_stmt', 




2380




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2381




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2382




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2383




 





 





 





 





 





 



     my @set_expr_nodes 




2384




 





 





 





 





 





 



         = grep { $_->get_attribute( 'view_part' ) eq 'SET' } 




2385




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




2386




 





 





 





 





 





 



     my @set_fields_list = (); 




2387




 





 





 





 





 





 



     my @set_values_list = (); 




2388




 





 





 





 





 





 



     for my $expr_node (@set_expr_nodes) { 




2389




 





 





 





 





 





 



         push @set_fields_list, $builder->build_identifier_element( 




2390




 





 





 





 





 





 



             $expr_node->get_attribute( 'set_src_field' ) ); 




2391




 





 





 





 





 





 



         push @set_values_list, $builder->build_expr( $expr_node ); 




2392




 





 





 





 





 





 



     } 




2393




 





 





 





 





 





 



     my $insert_fields_and_src = '(' . (join q{, }, @set_fields_list) . ') ' 




2394




 





 





 





 





 





 



         . 'VALUES (' . (join q{, }, @set_values_list) . ')'; 




2395




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2396




 





 





 





 





 





 



     return 'INSERT INTO ' . $object_name . ' ' . $insert_fields_and_src . ';' . "\n"; 




2397




 





 





 





 





 





 



 } 




2398




 





 





 





 





 





 



   




2399




 





 





 





 





 





 



 ###################################################################### 




2400




 





 





 





 





 





 



   




2401




 





 





 





 





 





 



 sub build_dmanip_update_stmt { 




2402




 





 





 





 





 





 



     # SQL:2003, 14.11 "" (p849) 




2403




 





 





 





 





 





 



     # SQL:2003, 14.12 "" (p853) 




2404




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2405




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_update_stmt', 




2406




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2407




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2408




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2409




 





 





 





 





 





 



     my @set_expr_nodes 




2410




 





 





 





 





 





 



         = grep { $_->get_attribute( 'view_part' ) eq 'SET' } 




2411




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




2412




 





 





 





 





 





 



     my @set_clause_list = (); 




2413




 





 





 





 





 





 



     for my $expr_node (@set_expr_nodes) { 




2414




 





 





 





 





 





 



         my $set_target = $builder->build_identifier_element( 




2415




 





 





 





 





 





 



             $expr_node->get_attribute( 'set_src_field' ) ); 




2416




 





 





 





 





 





 



         my $update_source = $builder->build_expr( $expr_node ); 




2417




 





 





 





 





 





 



         push @set_clause_list, $set_target . ' = ' . $update_source; 




2418




 





 





 





 





 





 



     } 




2419




 





 





 





 





 





 



     my $set_clause = 'SET ' . (join q{, }, @set_clause_list); 




2420




 





 





 





 





 





 



     my $where_clause = $builder->build_query_where_clause( $view_node ); 




2421




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2422




 





 





 





 





 





 



     return 'UPDATE ' . $object_name . ' ' . $set_clause . ' ' . $where_clause . ';' . "\n"; 




2423




 





 





 





 





 





 



 } 




2424




 





 





 





 





 





 



   




2425




 





 





 





 





 





 



 ###################################################################### 




2426




 





 





 





 





 





 



   




2427




 





 





 





 





 





 



 sub build_dmanip_delete_stmt { # SQL:2003, 14.7 "" (p831) 




2428




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2429




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_delete_stmt', 




2430




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2431




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2432




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2433




 





 





 





 





 





 



     my $where_clause = $builder->build_query_where_clause( $view_node ); 




2434




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2435




 





 





 





 





 





 



     return 'DELETE FROM ' . $object_name . ' ' . $where_clause . ';' . "\n"; 




2436




 





 





 





 





 





 



 } 




2437




 





 





 





 





 





 



   




2438




 





 





 





 





 





 



 ###################################################################### 




2439




 





 





 





 





 





 



   




2440




 





 





 





 





 





 



 sub build_dmanip_call_uroutine { 




2441




 





 





 





 





 





 



     # SQL:2003 ...  ... 




2442




 





 





 





 





 





 



     # SQL:2003, 15.1 "" (p885) 




2443




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2444




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_call_uroutine', 




2445




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2446




 





 





 





 





 





 



     my $uroutine = $rtn_stmt_node->get_attribute( 'call_uroutine' ); 




2447




 





 





 





 





 





 



     my $uroutine_name = $builder->build_identifier_schema_or_app_obj( $uroutine ); 




2448




 





 





 





 





 





 



     my %uroutine_arg_exprs 




2449




 





 





 





 





 





 



         = map { ($_->get_attribute( 'call_uroutine_arg' )->get_self_id() => $_) } 




2450




 





 





 





 





 





 



           @{$rtn_stmt_node->get_child_nodes( 'routine_expr' )}; 




2451




 





 





 





 





 





 



     # Note: The build_expr() calls are done below to ensure the arg values are 




2452




 





 





 





 





 





 



     # defined in the same order they are output; this lets optional insertion 




2453




 





 





 





 





 





 



     # of positionally determined host params (and their mapping) to work right. 




2454




 





 





 





 





 





 



     my $arg_val_list = join q{, }, 




2455




 





 





 





 





 





 



         map { $uroutine_arg_exprs{$_->get_self_id()} 




2456




 





 





 





 





 





 



               ? $builder->build_expr( $uroutine_arg_exprs{$_->get_self_id()} ) 




2457




 





 





 





 





 





 



               : 'NULL' } 




2458




 





 





 





 





 





 



         @{$uroutine->get_child_nodes( 'routine_arg' )}; 




2459




 





 





 





 





 





 



     #  ::= CALL  




2460




 





 





 





 





 





 



     return 'CALL ' . $uroutine_name . ($arg_val_list ? '(' . $arg_val_list . ')' : $EMPTY_STR) . ';' . "\n"; 




2461




 





 





 





 





 





 



 } 




2462




 





 





 





 





 





 



   




2463




 





 





 





 





 





 



 ###################################################################### 




2464




 





 





 





 





 





 



   




2465




 





 





 





 





 





 



 sub substitute_macros { 




2466




 





 





 





 





 





 



     my ($builder, $str, $subs) = @_; 




2467




 





 





 





 





 





 



     while (my ($key,$value) = each %{$subs}) { 




2468




 





 





 





 





 





 



         $str =~ s/ \{ $key \} /$value/x; 




2469




 





 





 





 





 





 



     } 




2470




 





 





 





 





 





 



     return $str; 




2471




 





 





 





 





 





 



 } 




2472




 





 





 





 





 





 



   




2473




 





 





 





 





 





 



 ###################################################################### 




2474




 





 





 





 





 





 



   




2475




 





 





 





 





 





 



 sub find_scalar_domain_for_row_domain_field { 




2476




 





 





 





 





 





 



     my ($builder, $scalar_data_type_node, $row_domain_node) = @_; 




2477




 





 





 





 





 





 



     my @candidates = grep { $_->get_attribute( 'data_type' )->get_self_id() eq $scalar_data_type_node->get_self_id() } 




2478




 





 





 





 





 





 



         @{$row_domain_node->get_primary_parent_attribute()->get_child_nodes( 'scalar_domain' )}; 




2479




 





 





 





 





 





 



     return $candidates[0] || $scalar_data_type_node; 




2480




 





 





 





 





 





 



 } 




2481




 





 





 





 





 





 



   




2482




 





 





 





 





 





 



 ###################################################################### 




2483




 





 





 





 





 





 



   




2484




 





 





 





 





 





 



 sub _scalar_data_type_of_node { 




2485




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2486




 





 





 





 





 





 



     $atnm ||= 'scalar_data_type'; 




2487




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2488




 





 





 





 





 





 



     if ($dt_or_dom_node->get_node_type() eq 'scalar_domain') { 




2489




 





 





 





 





 





 



         $dt_or_dom_node = $dt_or_dom_node->get_attribute( 'data_type' ); 




2490




 





 





 





 





 





 



     } 




2491




 





 





 





 





 





 



     return $dt_or_dom_node; 




2492




 





 





 





 





 





 



 } 




2493




 





 





 





 





 





 



   




2494




 





 





 





 





 





 



 sub _row_data_type_of_node { 




2495




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2496




 





 





 





 





 





 



     $atnm ||= 'row_data_type'; 




2497




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2498




 





 





 





 





 





 



     if ($dt_or_dom_node->get_node_type() eq 'row_domain') { 




2499




 





 





 





 





 





 



         $dt_or_dom_node = $dt_or_dom_node->get_attribute( 'data_type' ); 




2500




 





 





 





 





 





 



     } 




2501




 





 





 





 





 





 



     return $dt_or_dom_node; 




2502




 





 





 





 





 





 



 } 




2503




 





 





 





 





 





 



   




2504




 





 





 





 





 





 



 sub _row_domain_of_node { 




2505




 





 





 





 





 





 



     # returns domain or nothing 




2506




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2507




 





 





 





 





 





 



     $atnm ||= 'row_data_type'; 




2508




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2509




 





 





 





 





 





 



     return $dt_or_dom_node 




2510




 





 





 





 





 





 



         if $dt_or_dom_node->get_node_type() eq 'row_domain'; 




2511




 





 





 





 





 





 



     return; 




2512




 





 





 





 





 





 



 } 




2513




 





 





 





 





 





 



   




2514




 





 





 





 





 





 



 ###################################################################### 




2515




 





 





 





 





 





 



 # This is a 'protected' method; only sub-classes should invoke it. 




2516




 





 





 





 





 





 



   




2517




 





 





 





 





 





 



 sub _throw_error_message { 




2518




 





 





 





 





 





 



     my ($builder, $msg_key, $msg_vars) = @_; 




2519




 





 





 





 





 





 



     # Throws an exception consisting of an object. 




2520




 





 





 





 





 





 



     ref $msg_vars eq 'HASH' or $msg_vars = {}; 




2521




 





 





 





 





 





 



     for my $var_key (keys %{$msg_vars}) { 




2522




 





 





 





 





 





 



         if (ref $msg_vars->{$var_key} eq 'ARRAY') { 




2523




 





 





 





 





 





 



             $msg_vars->{$var_key} = 'PERL_ARRAY:[' . (join q{,},map {$_||$EMPTY_STR} @{$msg_vars->{$var_key}}) . ']'; 




2524




 





 





 





 





 





 



         } 




2525




 





 





 





 





 





 



     } 




2526




 





 





 





 





 





 



     die Locale::KeyedText->new_message( $msg_key, $msg_vars ); 




2527




 





 





 





 





 





 



 } 




2528




 





 





 





 





 





 



   




2529




 





 





 





 





 





 



 sub _assert_arg_node_type { 




2530




 





 





 





 





 





 



     my ($builder, $meth_name, $arg_name, $exp_node_types, $arg_value) = @_; 




2531




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_UNDEF', 




2532




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name } ) 




2533




 





 





 





 





 





 



         if !defined $arg_value; 




2534




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_NO_NODE', 




2535




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name, 'ARGVL' => $arg_value } ) 




2536




 





 





 





 





 





 



         if !ref $arg_value or !UNIVERSAL::isa( $arg_value, 'Rosetta::Model::Node' ); 




2537




 





 





 





 





 





 



     return 




2538




 





 





 





 





 





 



         if @{$exp_node_types} == 0; # any Node type is acceptable 




2539




 





 





 





 





 





 



     my $given_node_type = $arg_value->get_node_type(); 




2540




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_WRONG_NODE_TYPE', 




2541




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name, 




2542




 





 





 





 





 





 



         'EXPNTYPE' => $exp_node_types, 'ARGNTYPE' => $given_node_type } ) 




2543




 





 





 





 





 





 



         if !grep { $given_node_type eq $_ } @{$exp_node_types}; 




2544




 





 





 





 





 





 



     # If we get here, $arg_value is acceptable to the method. 




2545




 





 





 





 





 





 



 } 




2546




 





 





 





 





 





 



   




2547




 





 





 





 





 





 



 ###################################################################### 




2548




 





 





 





 





 





 



 ###################################################################### 




2549




 





 





 





 





 





 



   




2550




 





 





 





 





 





 



 1; 




2551




 





 





 





 





 





 



 __END__
        # it can be either a table or named view or subquery.
        return "\n" . 'FROM ' . $builder->build_query_table_factor( $view_src_nodes[0] );
    }
    else {
        # Complex case: There are 2 or more sources that are being joined.
        # The first step is to determine the join order, and only afterwards are
        # each  rendered into SQL; each  must be 




1335




 





 





 





 





 





 



         # generated in appearance order, so positional host param mapping works right. 




1336




 





 





 





 





 





 



         # Note: This code isn't very smart and assumes that all the view_join Nodes 




1337




 





 





 





 





 





 



         # are declared in the same order they should be output, even if their is 




1338




 





 





 





 





 





 



         # other evidence to the contrary.  This code can be smartened later. 




1339




 





 





 





 





 





 



         # This code also assumes that the ROS M is correct, such that all defined 




1340




 





 





 





 





 





 



         # view_src Nodes are involved in a single common view_join; there should be 




1341




 





 





 





 





 





 



         # exactly one fewer view_join Node than there are view_src Nodes. 




1342




 





 





 





 





 





 



         # TODO: Support the Oracle-8 way of putting join conditions in WHERE. 




1343




 





 





 





 





 





 



         my @sql_fragment_list = (); 




1344




 





 





 





 





 





 



         push @sql_fragment_list, $builder->build_query_table_factor( 




1345




 





 





 





 





 





 



             $view_join_nodes[0]->get_attribute( 'lhs_src' ) ); 




1346




 





 





 





 





 





 



         for my $view_join_node (@view_join_nodes) { 




1347




 





 





 





 





 





 



             my $join_op = $view_join_node->get_attribute( 'join_op' ); 




1348




 





 





 





 





 





 



             push @sql_fragment_list, "\n" 




1349




 





 





 





 





 





 



                  . ( $join_op eq 'CROSS' ? 'CROSS JOIN' 




1350




 





 





 





 





 





 



                    : $join_op eq 'INNER' ? 'INNER JOIN' 




1351




 





 





 





 





 





 



                    : $join_op eq 'LEFT'  ? 'LEFT OUTER JOIN' 




1352




 





 





 





 





 





 



                    : $join_op eq 'RIGHT' ? 'RIGHT OUTER JOIN' 




1353




 





 





 





 





 





 



                    : $join_op eq 'FULL'  ? 'FULL OUTER JOIN' 




1354




 





 





 





 





 





 



                    :                       undef # we should never get here 




1355




 





 





 





 





 





 



                    ); 




1356




 





 





 





 





 





 



             push @sql_fragment_list, $builder->build_query_table_factor( 




1357




 





 





 





 





 





 



                 $view_join_node->get_attribute( 'rhs_src' ) ); 




1358




 





 





 





 





 





 



             my @join_on_sql = (); 




1359




 





 





 





 





 





 



             for my $view_join_field_node (@{$view_join_node->get_child_nodes( 'view_join_field' )}) { 




1360




 





 





 





 





 





 



                 my $lhs_src_field_name = $builder->build_identifier_view_src_field( 




1361




 





 





 





 





 





 



                     $view_join_field_node->get_attribute( 'lhs_src_field' ) ); 




1362




 





 





 





 





 





 



                 my $rhs_src_field_name = $builder->build_identifier_view_src_field( 




1363




 





 





 





 





 





 



                     $view_join_field_node->get_attribute( 'rhs_src_field' ) ); 




1364




 





 





 





 





 





 



                 push @join_on_sql, $rhs_src_field_name . ' = ' . $lhs_src_field_name; 




1365




 





 





 





 





 





 



             } 




1366




 





 





 





 





 





 



             push @sql_fragment_list, 'ON ' . (join ' AND ', @join_on_sql); 




1367




 





 





 





 





 





 



         } 




1368




 





 





 





 





 





 



         return "\n" . 'FROM ' . (join ' ', @sql_fragment_list); 




1369




 





 





 





 





 





 



     } 




1370




 





 





 





 





 





 



 } 




1371




 





 





 





 





 





 



   




1372




 





 





 





 





 





 



 sub build_query_table_factor { # SQL:2003, 7.6 "" (p303) 




1373




 





 





 





 





 





 



     my ($builder, $view_src_node) = @_; 




1374




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_table_factor', 




1375




 





 





 





 





 





 



         'VIEW_SRC_NODE', ['view_src'], $view_src_node ); 




1376




 





 





 





 





 





 



     # Maybe TODO:  




1377




 





 





 





 





 





 



     my $correlation_name = $builder->build_identifier_element( $view_src_node ); 




1378




 





 





 





 





 





 



     my $match_node = $view_src_node->get_attribute( 'match' ); 




1379




 





 





 





 





 





 



     my $match_name = $builder->build_identifier_schema_or_app_obj( $match_node ); 




1380




 





 





 





 





 





 



     if ($match_node->get_node_type() eq 'view') { 




1381




 





 





 





 





 





 



         if ($match_node->get_primary_parent_attribute()->get_node_type() eq 'view') { 




1382




 





 





 





 





 





 



             # The view we are matching is a subquery. 




1383




 





 





 





 





 





 



             if ($builder->{$PROP_INLINE_SUBQ}) { 




1384




 





 





 





 





 





 



                 # Embed an anonymous subquery; argument passing is not yet supported. 




1385




 





 





 





 





 





 



                 my $query_expression = $builder->build_query_query_expr( $match_node ); 




1386




 





 





 





 





 





 



                 return '(' . $query_expression . ') AS ' . $correlation_name; 




1387




 





 





 





 





 





 



             } 




1388




 





 





 





 





 





 



             else { 




1389




 





 





 





 





 





 



                 # Call a named subquery; argument passing is supported. 




1390




 





 





 





 





 





 



                 my %src_args_to_view_exprs 




1391




 





 





 





 





 





 



                     = map { ($_->get_attribute( 'call_src_arg' )->get_self_id() => $_) } 




1392




 





 





 





 





 





 



                       grep { $_->get_attribute( 'view_part' ) eq 'FROM' } 




1393




 





 





 





 





 





 



                       @{$view_src_node->get_primary_parent_attribute()->get_child_nodes( 'view_expr' )}; 




1394




 





 





 





 





 





 



                 my %view_args_to_src_args 




1395




 





 





 





 





 





 



                     = map { ($_->get_attribute( 'match_view_arg' )->get_self_id() => $_) } 




1396




 





 





 





 





 





 



                       @{$view_src_node->get_child_nodes( 'view_src_arg' )}; 




1397




 





 





 





 





 





 



                 # Note: The build_expr() calls are done below to ensure the arg values are 




1398




 





 





 





 





 





 



                 # defined in the same order they are output; this lets optional insertion 




1399




 





 





 





 





 





 



                 # of positionally determined host params (and their mapping) to work right. 




1400




 





 





 





 





 





 



                 my $arg_list = join q{, }, 




1401




 





 





 





 





 





 



                     map { ($_ ? $builder->build_expr( $_ ) : 'NULL') } 




1402




 





 





 





 





 





 



                     map { $src_args_to_view_exprs{$view_args_to_src_args{$_->get_self_id()}->get_self_id()} } 




1403




 





 





 





 





 





 



                     @{$match_node->get_child_nodes( 'view_arg' )}; 




1404




 





 





 





 





 





 



                 return $match_name 




1405




 





 





 





 





 





 



                        . ($arg_list ? '(' . $arg_list . ')' : $EMPTY_STR) 




1406




 





 





 





 





 





 



                        . ' AS ' . $correlation_name; 




1407




 





 





 





 





 





 



             } 




1408




 





 





 





 





 





 



         } 




1409




 





 





 





 





 





 



         else { 




1410




 





 





 





 





 





 



             # The view we are matching is a schema object. 




1411




 





 





 





 





 





 



             return $match_name . ' AS ' . $correlation_name; 




1412




 





 





 





 





 





 



         } 




1413




 





 





 





 





 





 



     } 




1414




 





 





 





 





 





 



     else { # the source node is a base table schema object or a local variable of some kind 




1415




 





 





 





 





 





 



         return $match_name . ' AS ' . $correlation_name; 




1416




 





 





 





 





 





 



     } 




1417




 





 





 





 





 





 



 } 




1418




 





 





 





 





 





 



   




1419




 





 





 





 





 





 



 ###################################################################### 




1420




 





 





 





 





 





 



   




1421




 





 





 





 





 





 



 sub build_query_where_clause { # SQL:2003, 7.8 "" (p319) 




1422




 





 





 





 





 





 



     # Function returns empty string if view has no where clause. 




1423




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1424




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_where_clause', 




1425




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1426




 





 





 





 





 





 



     my @expr_list 




1427




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1428




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'WHERE' } 




1429




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1430




 





 





 





 





 





 



     return @expr_list ? "\n" . 'WHERE ' . $expr_list[0] : $EMPTY_STR; 




1431




 





 





 





 





 





 



 } 




1432




 





 





 





 





 





 



   




1433




 





 





 





 





 





 



 ###################################################################### 




1434




 





 





 





 





 





 



   




1435




 





 





 





 





 





 



 sub build_query_group_clause { # SQL:2003, 7.9 "" (p320) 




1436




 





 





 





 





 





 



     # Function returns empty string if view has no group by clause. 




1437




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1438




 





 





 





 





 





 



     my @expr_list 




1439




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1440




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'GROUP' } 




1441




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1442




 





 





 





 





 





 



     return @expr_list ? "\n" . 'GROUP BY ' . (join q{, }, @expr_list) : $EMPTY_STR; 




1443




 





 





 





 





 





 



     # Notes: Within build_expr(): 




1444




 





 





 





 





 





 



     #  implemented by COL basic_expr_type, 




1445




 





 





 





 





 





 



     #  and  implemented by LIST basic_expr_type, 




1446




 





 





 





 





 





 



     #  impl by ROSMN named GB_SETS, 




1447




 





 





 





 





 





 



     #  impl by ROSMN named GB_RLUP, 




1448




 





 





 





 





 





 



     #  impl by ROSMN named GB_CUBE. 




1449




 





 





 





 





 





 



     # Note:  has opt , looks redundant w SEL DIST|ALL; not impl. 




1450




 





 





 





 





 





 



 } 




1451




 





 





 





 





 





 



   




1452




 





 





 





 





 





 



 ###################################################################### 




1453




 





 





 





 





 





 



   




1454




 





 





 





 





 





 



 sub build_query_having_clause { # SQL:2003, 7.10 "" (p329) 




1455




 





 





 





 





 





 



     # Function returns empty string if view has no having clause. 




1456




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1457




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_having_clause', 




1458




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1459




 





 





 





 





 





 



     my @expr_list 




1460




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1461




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'HAVING' } 




1462




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1463




 





 





 





 





 





 



     return @expr_list ? "\n" . 'HAVING ' . $expr_list[0] : $EMPTY_STR; 




1464




 





 





 





 





 





 



 } 




1465




 





 





 





 





 





 



   




1466




 





 





 





 





 





 



 ###################################################################### 




1467




 





 





 





 





 





 



   




1468




 





 





 





 





 





 



 sub build_query_window_clause { # SQL:2003, 7.11 "" (p331) 




1469




 





 





 





 





 





 



     # Function returns empty string if view has no window clause. 




1470




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1471




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_window_clause', 




1472




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1473




 





 





 





 





 





 



     # TODO: I need to first update Rosetta::Model a bit re the various 




1474




 





 





 





 





 





 



     # parts of a , then fix here.  Meanwhile, I dump what I got. 




1475




 





 





 





 





 





 



     # Also see SQL:2003, 10.10 "" (p517) for future reference. 




1476




 





 





 





 





 





 



     my @order_list 




1477




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1478




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'ORDER' } 




1479




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1480




 





 





 





 





 





 



     my @maxr_list 




1481




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1482




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'MAXR' } 




1483




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1484




 





 





 





 





 





 



     my @skipr_list 




1485




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1486




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'SKIPR' } 




1487




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1488




 





 





 





 





 





 



     return (@order_list ? "\n" . 'ORDER BY ' . (join q{, }, @order_list) : $EMPTY_STR) 




1489




 





 





 





 





 





 



            . (@maxr_list ? "\n" . 'LIMIT ' . $maxr_list[0] : $EMPTY_STR) 




1490




 





 





 





 





 





 



            . (@skipr_list ? "\n" . 'OFFSET ' . $skipr_list[0] : $EMPTY_STR); 




1491




 





 





 





 





 





 



 } 




1492




 





 





 





 





 





 



   




1493




 





 





 





 





 





 



 ###################################################################### 




1494




 





 





 





 





 





 



   




1495




 





 





 





 





 





 



 sub build_query_query_spec { 




1496




 





 





 





 





 





 



     # SQL:2003, 7.12 "" (p341) 




1497




 





 





 





 





 





 



     # SQL:2003, 14.5 "" (p824) 




1498




 





 





 





 





 





 



     my ($builder, $view_node, $into_dest_node) = @_; 




1499




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_query_spec', 




1500




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1501




 





 





 





 





 





 



     defined $into_dest_node and $builder->_assert_arg_node_type( 'build_query_query_spec', 




1502




 





 





 





 





 





 



         'INTO_DEST_NODE', ['routine_arg','routine_var'], $into_dest_node ); 




1503




 





 





 





 





 





 



     # Method assumes that $view_node.view_type ne 'COMPOUND'; 




1504




 





 





 





 





 





 



     # method should never be invoked for those kinds of views. 




1505




 





 





 





 





 





 



     my $set_quantifier = $view_node->get_attribute( 'distinct_rows' ) ? 'DISTINCT' : 'ALL'; 




1506




 





 





 





 





 





 



     my $select_list = $builder->build_query_select_list( $view_node ); 




1507




 





 





 





 





 





 



     my $into_clause = $into_dest_node ? "\n" . 'INTO ' . $builder->build_identifier_element( $into_dest_node ) : $EMPTY_STR; 




1508




 





 





 





 





 





 



     my $table_expression = $builder->build_query_table_expr( $view_node ); 




1509




 





 





 





 





 





 



     return "\n" . 'SELECT ' . $set_quantifier . ' ' . $select_list . $into_clause . $table_expression; 




1510




 





 





 





 





 





 



 } 




1511




 





 





 





 





 





 



   




1512




 





 





 





 





 





 



 ###################################################################### 




1513




 





 





 





 





 





 



   




1514




 





 





 





 





 





 



 sub build_query_select_list { # SQL:2003, 7.12 "" (p341) 




1515




 





 





 





 





 





 



     # Method returns comma-delimited list expression where each list item is a 




1516




 





 





 





 





 





 



     # " ::=  AS ". 




1517




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1518




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_select_list', 




1519




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1520




 





 





 





 





 





 



     if ($view_node->get_attribute( 'view_type' ) eq 'ALIAS') { 




1521




 





 





 





 





 





 



         # Each result column must match a source column exactly. 




1522




 





 





 





 





 





 



         # Every source table/view result column or var field is output, with the same name. 




1523




 





 





 





 





 





 



         # It is assumed/required that the view has the same 'row_data_type' as the source. 




1524




 





 





 





 





 





 



         # While '*' would conceptually work here, we still explicitly enumerate col name list 




1525




 





 





 





 





 





 



         # so compound selects and select-intos don't break when original create tbl/vw statement 




1526




 





 





 





 





 





 



         # had declared columns in a different order than our row-data-type does. 




1527




 





 





 





 





 





 



         my $row_data_type_node = $builder->_row_data_type_of_node( $view_node ); 




1528




 





 





 





 





 





 



         return join q{, } . "\n", 




1529




 





 





 





 





 





 



             map { $builder->build_identifier_element( $_ ) } 




1530




 





 





 





 





 





 



             @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}; 




1531




 





 





 





 





 





 



     } 




1532




 





 





 





 





 





 



     else { # view_type ne 'ALIAS' 




1533




 





 





 





 





 





 



         # Each result column may come from an arbitrarily complex expression. 




1534




 





 





 





 





 





 



         # We have three statements below instead of one because we want the result cols shown 




1535




 





 





 





 





 





 



         # in order of the view's "row_data_type_field" Nodes, not the order of the 'view_part' if different. 




1536




 





 





 





 





 





 



         my %select_list_view_fields 




1537




 





 





 





 





 





 



             = map { ($_->get_attribute( 'si_row_field' )->get_self_id() => $_->get_attribute( 'src_field' )) } 




1538




 





 





 





 





 





 



               @{$view_node->get_child_nodes( 'view_field' )}; # note: 'src_field' may be undefined 




1539




 





 





 





 





 





 



         my %select_list_view_exprs 




1540




 





 





 





 





 





 



             = map { ($_->get_attribute( 'set_result_field' )->get_self_id() => $_) } 




1541




 





 





 





 





 





 



               grep { $_->get_attribute( 'view_part' ) eq 'RESULT' } 




1542




 





 





 





 





 





 



               @{$view_node->get_child_nodes( 'view_expr' )}; 




1543




 





 





 





 





 





 



         # Note: The build_expr() calls are done below to ensure the arg values are 




1544




 





 





 





 





 





 



         # defined in the same order they are output; this lets optional insertion 




1545




 





 





 





 





 





 



         # of positionally determined host params (and their mapping) to work right. 




1546




 





 





 





 





 





 



         my $row_data_type_node = $builder->_row_data_type_of_node( $view_node ); 




1547




 





 





 





 





 





 



         return join q{, } . "\n", 




1548




 





 





 





 





 





 



             map { ($select_list_view_fields{$_->get_self_id()} 




1549




 





 





 





 





 





 



                    ? $builder->build_identifier_view_src_field( $select_list_view_fields{$_->get_self_id()} ) 




1550




 





 





 





 





 





 



                    : $select_list_view_exprs{$_->get_self_id()} 




1551




 





 





 





 





 





 



                    ? $builder->build_expr( $select_list_view_exprs{$_->get_self_id()} ) 




1552




 





 





 





 





 





 



                    : 'NULL') 




1553




 





 





 





 





 





 



                 . ' AS ' . $builder->build_identifier_element( $_ ) } 




1554




 





 





 





 





 





 



             @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}; 




1555




 





 





 





 





 





 



         # Note that the default of NULL thing deals with view's row field that don't have any view_expr or src_field. 




1556




 





 





 





 





 





 



         # TODO IF NOT WRONG/OUTDATED: Note that the 'view_field' Nodes we actually need may be in a parent view 




1557




 





 





 





 





 





 



         # of the current view; right now we only are looking in the current view. 




1558




 





 





 





 





 





 



     } 




1559




 





 





 





 





 





 



 } 




1560




 





 





 





 





 





 



   




1561




 





 





 





 





 





 



 ###################################################################### 




1562




 





 





 





 





 





 



   




1563




 





 





 





 





 





 



 sub build_query_query_expr { # SQL:2003, 7.13 "" (p351) 




1564




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1565




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_query_expr', 




1566




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1567




 





 





 





 





 





 



     my $view_type = $view_node->get_attribute( 'view_type' ); 




1568




 





 





 





 





 





 



     my $with_clause = $EMPTY_STR; 




1569




 





 





 





 





 





 



     if (!$builder->{$PROP_INLINE_SUBQ}) { 




1570




 





 





 





 





 





 



         my @with_list = (); 




1571




 





 





 





 





 





 



         my $recursive = 0; 




1572




 





 





 





 





 





 



         for my $child_view_node (@{$view_node->get_child_nodes( 'view' )}) { 




1573




 





 





 





 





 





 



             if ($child_view_node->get_attribute( 'recursive' )) { 




1574




 





 





 





 





 





 



                 $recursive = 1; 




1575




 





 





 





 





 





 



             } 




1576




 





 





 





 





 





 



             my $with_item = $builder->build_identifier_element( $child_view_node ); 




1577




 





 





 





 





 





 



             if (my @child_arg_nodes = @{$child_view_node->get_child_nodes( 'view_arg' )}) { 




1578




 





 





 





 





 





 



                 $with_item .= '(' . (join q{, }, 




1579




 





 





 





 





 





 



                     map { $builder->build_identifier_element( $_ ) } 




1580




 





 





 





 





 





 



                     @child_arg_nodes) . ')'; 




1581




 





 





 





 





 





 



             } 




1582




 





 





 





 





 





 



             $with_item .= ' AS (' . $builder->build_query_query_expr( $child_view_node ) . ')'; 




1583




 





 





 





 





 





 



             push @with_list, $with_item; 




1584




 





 





 





 





 





 



         } 




1585




 





 





 





 





 





 



         if (@with_list) { 




1586




 





 





 





 





 





 



             $with_clause = "\n" . 'WITH ' . ($recursive ? 'RECURSIVE ' : $EMPTY_STR) . (join q{, }, @with_list); 




1587




 





 





 





 





 





 



         } 




1588




 





 





 





 





 





 



     } 




1589




 





 





 





 





 





 



     my $query_expression_body = $builder->build_query_query_expr_body( $view_node ); 




1590




 





 





 





 





 





 



     return $with_clause . $query_expression_body; 




1591




 





 





 





 





 





 



     # TODO: SQL:2003, 7.14 "" (p365). 




1592




 





 





 





 





 





 



 } 




1593




 





 





 





 





 





 



   




1594




 





 





 





 





 





 



 ###################################################################### 




1595




 





 





 





 





 





 



   




1596




 





 





 





 





 





 



 sub build_query_query_expr_body { # SQL:2003, 7.13 "" (p351) 




1597




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1598




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_query_expr_body', 




1599




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1600




 





 





 





 





 





 



     if ($view_node->get_attribute( 'view_type' ) eq 'COMPOUND') { 




1601




 





 





 





 





 





 



         # Result is multiple "SELECT ..." connected by one or more compound operators. 




1602




 





 





 





 





 





 



         my $compound_op = $view_node->get_attribute( 'compound_op' ); 




1603




 





 





 





 





 





 



         my $set_quantifier = $view_node->get_attribute( 'distinct_rows' ) ? 'DISTINCT' : 'ALL'; 




1604




 





 





 





 





 





 



         my @operand_list = (); 




1605




 





 





 





 





 





 



         for my $elem_node (@{$view_node->get_child_nodes( 'view_compound_elem' )}) { 




1606




 





 





 





 





 





 



             my $view_src_node = $elem_node->get_attribute( 'operand' ); 




1607




 





 





 





 





 





 



             my $match_node = $view_src_node->get_attribute( 'match' ); 




1608




 





 





 





 





 





 



             my $match_name = $builder->build_identifier_schema_or_app_obj( $match_node ); 




1609




 





 





 





 





 





 



             # Each compounding operand is assumed to have the same row data type as the view. 




1610




 





 





 





 





 





 



             if ($match_node->get_node_type() eq 'table') { 




1611




 





 





 





 





 





 



                 my $row_data_type_node = $builder->_row_data_type_of_node( $match_node ); 




1612




 





 





 





 





 





 



                 push @operand_list, join q{, } . "\n", 




1613




 





 





 





 





 





 



                     map { $builder->build_identifier_element( $_ ) } 




1614




 





 





 





 





 





 



                     @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}; 




1615




 





 





 





 





 





 



             } 




1616




 





 





 





 





 





 



             elsif ($match_node->get_node_type() eq 'view') { 




1617




 





 





 





 





 





 



                 push @operand_list, $builder->build_query_query_expr( $match_node ); 




1618




 





 





 





 





 





 



             } 




1619




 





 





 





 





 





 



             else { # the source node is a local variable of some kind 




1620




 





 





 





 





 





 



                 push @operand_list, $match_name; 




1621




 





 





 





 





 





 



             } 




1622




 





 





 





 





 





 



         } 




1623




 





 





 





 





 





 



         my $sql_operator 




1624




 





 





 





 





 





 



             = $compound_op eq 'UNION'        ? 'UNION' 




1625




 





 





 





 





 





 



             : $compound_op eq 'DIFFERENCE'   ? 'EXCEPT' 




1626




 





 





 





 





 





 



             : $compound_op eq 'INTERSECTION' ? 'INTERSECT' 




1627




 





 





 





 





 





 



             : $compound_op eq 'EXCLUSION'    ? 'EXCLUSION' # this 4th option not in SQL:2003. 




1628




 





 





 





 





 





 



             :                                  undef # we should never get here 




1629




 





 





 





 





 





 



             ; 




1630




 





 





 





 





 





 



             # TODO: try to emulate 'EXCLUSION' somewhere. 




1631




 





 





 





 





 





 



         return '(' . (join "\n" . $sql_operator . '_' . $set_quantifier, @operand_list) . ')'; 




1632




 





 





 





 





 





 



         # TODO: deal with engines that don't like "()" bounding compound operations. 




1633




 





 





 





 





 





 



         # TODO: possibly implement . 




1634




 





 





 





 





 





 



     } 




1635




 





 





 





 





 





 



     else { # view type ne 'COMPOUND' 




1636




 





 





 





 





 





 



         # Result is a single "SELECT ...", also known as a single "". 




1637




 





 





 





 





 





 



         return $builder->build_query_query_spec( $view_node ); 




1638




 





 





 





 





 





 



     } 




1639




 





 





 





 





 





 



 } 




1640




 





 





 





 





 





 



   




1641




 





 





 





 





 





 



 ###################################################################### 




1642




 





 





 





 





 





 



   




1643




 





 





 





 





 





 



 sub build_query_subquery { # SQL:2003, 7.15 "" (p370) 




1644




 





 





 





 





 





 



     my ($builder, $expr_node) = @_; 




1645




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_subquery', 




1646




 





 





 





 





 





 



         'EXPR_NODE', ['view_expr'], $expr_node ); 




1647




 





 





 





 





 





 



     my $cview = $expr_node->get_attribute( 'valf_call_view' ); 




1648




 





 





 





 





 





 



     if ($builder->{$PROP_INLINE_SUBQ}) { 




1649




 





 





 





 





 





 



         # Embed an anonymous subquery; argument passing is not yet supported. 




1650




 





 





 





 





 





 



         my $query_expression = $builder->build_query_query_expr( $cview ); 




1651




 





 





 





 





 





 



         return '(' . $query_expression . ')'; 




1652




 





 





 





 





 





 



     } 




1653




 





 





 





 





 





 



     else { 




1654




 





 





 





 





 





 



         # Call a named subquery; argument passing is supported. 




1655




 





 





 





 





 





 



         my $cview_name = $builder->build_identifier_schema_or_app_obj( $cview ); 




1656




 





 





 





 





 





 



         my %cview_arg_exprs 




1657




 





 





 





 





 





 



             = map { ($_->get_attribute( 'call_view_arg' )->get_self_id() => $_) } 




1658




 





 





 





 





 





 



               @{$expr_node->get_child_nodes()}; # gets child view_expr Nodes 




1659




 





 





 





 





 





 



         # Note: The build_expr() calls are done below to ensure the arg values are 




1660




 





 





 





 





 





 



         # defined in the same order they are output; this lets optional insertion 




1661




 





 





 





 





 





 



         # of positionally determined host params (and their mapping) to work right. 




1662




 





 





 





 





 





 



         my $arg_val_list = join q{, }, 




1663




 





 





 





 





 





 



             map { $cview_arg_exprs{$_->get_self_id()} 




1664




 





 





 





 





 





 



                   ? $builder->build_expr( $cview_arg_exprs{$_->get_self_id()} ) 




1665




 





 





 





 





 





 



                   : 'NULL' } 




1666




 





 





 





 





 





 



             @{$cview->get_child_nodes( 'view_arg' )}; 




1667




 





 





 





 





 





 



         return $cview_name . ($arg_val_list ? '(' . $arg_val_list . ')' : $EMPTY_STR); 




1668




 





 





 





 





 





 



     } 




1669




 





 





 





 





 





 



     # Note: Direct calls to schema object tables or views is not supported outside of 'FROM'. 




1670




 





 





 





 





 





 



 } 




1671




 





 





 





 





 





 



   




1672




 





 





 





 





 





 



 ###################################################################### 




1673




 





 





 





 





 





 



   




1674




 





 





 





 





 





 



 sub build_schema_create { # SQL:2003, 11.1 "" (p519) 




1675




 





 





 





 





 





 



     my ($builder, $schema_node) = @_; 




1676




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_create', 




1677




 





 





 





 





 





 



         'SCHEMA_NODE', ['schema'], $schema_node ); 




1678




 





 





 





 





 





 



     my $schema_name = $builder->build_identifier_element( $schema_node ); 




1679




 





 





 





 





 





 



     my $authorization = $EMPTY_STR; # TODO: AUTHORIZATION  




1680




 





 





 





 





 





 



     # Some other features in 11.1, such as default character set. 




1681




 





 





 





 





 





 



     return 'CREATE SCHEMA ' . $schema_name . ' ' . $authorization . ';' . "\n"; 




1682




 





 





 





 





 





 



 } 




1683




 





 





 





 





 





 



   




1684




 





 





 





 





 





 



 sub build_schema_delete { # SQL:2003, 11.2 "" (p522) 




1685




 





 





 





 





 





 



     my ($builder, $schema_node) = @_; 




1686




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_delete', 




1687




 





 





 





 





 





 



         'SCHEMA_NODE', ['schema'], $schema_node ); 




1688




 





 





 





 





 





 



     my $schema_name = $builder->build_identifier_element( $schema_node ); 




1689




 





 





 





 





 





 



     return 'DROP SCHEMA ' . $schema_name . ';' . "\n"; 




1690




 





 





 





 





 





 



 } 




1691




 





 





 





 





 





 



   




1692




 





 





 





 





 





 



 ###################################################################### 




1693




 





 





 





 





 





 



   




1694




 





 





 





 





 





 



 sub build_schema_or_app_scalar_domain_create { # SQL:2003, 11.24 "" (p603) 




1695




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1696




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_scalar_domain_create', 




1697




 





 





 





 





 





 



         'DOMAIN_NODE', ['scalar_domain'], $domain_node ); 




1698




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1699




 





 





 





 





 





 



     my $predefined_type = $builder->build_expr_scalar_data_type_defn( $domain_node ); 




1700




 





 





 





 





 





 



     # TODO: default clause, domain constraint, collate clause. 




1701




 





 





 





 





 





 



     my $is_temp = ($domain_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1702




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' DOMAIN ' . $domain_name . ' AS ' . $predefined_type . ';' . "\n"; 




1703




 





 





 





 





 





 



 } 




1704




 





 





 





 





 





 



   




1705




 





 





 





 





 





 



 sub build_schema_or_app_scalar_domain_delete { # SQL:2003, 11.30 "" (p610) 




1706




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1707




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_scalar_domain_delete', 




1708




 





 





 





 





 





 



         'DOMAIN_NODE', ['scalar_domain'], $domain_node ); 




1709




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1710




 





 





 





 





 





 



     return 'DROP DOMAIN ' . $domain_name . ';' . "\n"; 




1711




 





 





 





 





 





 



 } 




1712




 





 





 





 





 





 



   




1713




 





 





 





 





 





 



 ###################################################################### 




1714




 





 





 





 





 





 



   




1715




 





 





 





 





 





 



 sub build_schema_or_app_row_domain_create { # SQL:2003, 11.24 "" (p603) 




1716




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1717




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_row_domain_create', 




1718




 





 





 





 





 





 



         'DOMAIN_NODE', ['row_domain'], $domain_node ); 




1719




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1720




 





 





 





 





 





 



     my $predefined_type = $builder->build_expr_row_data_type_defn( $domain_node ); 




1721




 





 





 





 





 





 



     # TODO: default clause, domain constraint, collate clause. 




1722




 





 





 





 





 





 



     my $is_temp = ($domain_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1723




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' DOMAIN ' . $domain_name . ' AS ' . $predefined_type . ';' . "\n"; 




1724




 





 





 





 





 





 



 } 




1725




 





 





 





 





 





 



   




1726




 





 





 





 





 





 



 sub build_schema_or_app_row_domain_delete { # SQL:2003, 11.30 "" (p610) 




1727




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1728




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_row_domain_delete', 




1729




 





 





 





 





 





 



         'DOMAIN_NODE', ['row_domain'], $domain_node ); 




1730




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1731




 





 





 





 





 





 



     return 'DROP DOMAIN ' . $domain_name . ';' . "\n"; 




1732




 





 





 





 





 





 



 } 




1733




 





 





 





 





 





 



   




1734




 





 





 





 





 





 



 ###################################################################### 




1735




 





 





 





 





 





 



   




1736




 





 





 





 





 





 



 sub build_schema_or_app_sequence_create { # SQL:2003, 11.62 "" (p726) 




1737




 





 





 





 





 





 



     my ($builder, $sequence_node) = @_; 




1738




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_sequence_create', 




1739




 





 





 





 





 





 



         'SEQUENCE_NODE', ['sequence'], $sequence_node ); 




1740




 





 





 





 





 





 



     # SQL:2003 allows multiple data types for this, but we stick to integers for now. 




1741




 





 





 





 





 





 



     my $sequence_name = $builder->build_identifier_schema_or_app_obj( $sequence_node, 1 ); 




1742




 





 





 





 





 





 



     my $increment = $sequence_node->get_attribute( 'increment' ); 




1743




 





 





 





 





 





 



     my $min_val = $sequence_node->get_attribute( 'min_val' ); 




1744




 





 





 





 





 





 



     my $max_val = $sequence_node->get_attribute( 'max_val' ); 




1745




 





 





 





 





 





 



     my $start_val = $sequence_node->get_attribute( 'start_val' ); 




1746




 





 





 





 





 





 



     my $cycle = $sequence_node->get_attribute( 'cycle' ); 




1747




 





 





 





 





 





 



     my $order = $sequence_node->get_attribute( 'order' ); 




1748




 





 





 





 





 





 



     # Note that Rosetta::Model guarantees all integer attributes are already valid integers. 




1749




 





 





 





 





 





 



     my $is_temp = ($sequence_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1750




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' SEQUENCE ' . $sequence_name 




1751




 





 





 





 





 





 



         . (defined $increment ? ' INCREMENT BY ' . $increment : $EMPTY_STR) 




1752




 





 





 





 





 





 



         . (defined $start_val ? ' START WITH ' . $start_val : $EMPTY_STR) 




1753




 





 





 





 





 





 



         . (defined $min_val ? ' MINVALUE ' . $min_val : ' NO MINVALUE') 




1754




 





 





 





 





 





 



         . (defined $max_val ? ' MAXVALUE ' . $max_val : ' NO MAXVALUE') 




1755




 





 





 





 





 





 



         . ($cycle ? ' CYCLE' : ' NO CYCLE') 




1756




 





 





 





 





 





 



         . ($order ? ' ORDER' : ' NO ORDER') # standard doesn't mention this one 




1757




 





 





 





 





 





 



         . ';' . "\n"; 




1758




 





 





 





 





 





 



 } 




1759




 





 





 





 





 





 



   




1760




 





 





 





 





 





 



 sub build_schema_or_app_sequence_delete { # SQL:2003, 11.64 "" (p729) 




1761




 





 





 





 





 





 



     my ($builder, $sequence_node) = @_; 




1762




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_sequence_delete', 




1763




 





 





 





 





 





 



         'SEQUENCE_NODE', ['sequence'], $sequence_node ); 




1764




 





 





 





 





 





 



     my $sequence_name = $builder->build_identifier_schema_or_app_obj( $sequence_node, 1 ); 




1765




 





 





 





 





 





 



     return 'DROP SEQUENCE ' . $sequence_name . ';' . "\n"; 




1766




 





 





 





 





 





 



 } 




1767




 





 





 





 





 





 



   




1768




 





 





 





 





 





 



 ###################################################################### 




1769




 





 





 





 





 





 



   




1770




 





 





 





 





 





 



 sub build_schema_or_app_table_create { 




1771




 





 





 





 





 





 



     # SQL:2003, 6.2 "" (p173) 




1772




 





 





 





 





 





 



     # SQL:2003, 11.3 "" (p525) 




1773




 





 





 





 





 





 



     # SQL:2003, 11.4 "" (p536) 




1774




 





 





 





 





 





 



     # SQL:2003, 11.5 "" (p541) 




1775




 





 





 





 





 





 



     # SQL:2003, 11.6 "" (p545) 




1776




 





 





 





 





 





 



     # SQL:2003, 11.7 "" (p547) 




1777




 





 





 





 





 





 



     # SQL:2003, 11.8 "" (p549) 




1778




 





 





 





 





 





 



     # TODO: SQL:2003, 11.9 "" (p569) 




1779




 





 





 





 





 





 



     # TODO: "GENERATED ALWAYS AS ..." which looks like FileMaker's (etc) "calculation" field types. 




1780




 





 





 





 





 





 



     my ($builder, $table_node) = @_; 




1781




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_table_create', 




1782




 





 





 





 





 





 



         'TABLE_NODE', ['table'], $table_node ); 




1783




 





 





 





 





 





 



     my $table_name = $builder->build_identifier_schema_or_app_obj( $table_node, 1 ); 




1784




 





 





 





 





 





 



     my @table_field_sql = (); 




1785




 





 





 





 





 





 



     my %col_name_cache = (); # used when making ind defs 




1786




 





 





 





 





 





 



     my %mandatory_field_cache = (); # used when making ind defs 




1787




 





 





 





 





 





 



     my %table_fields_by_row_field = map { ($_->get_attribute( 'si_row_field' )->get_self_id() => $_) } 




1788




 





 





 





 





 





 



         @{$table_node->get_child_nodes( 'table_field' )}; 




1789




 





 





 





 





 





 



     my $row_data_type_node = $builder->_row_data_type_of_node( $table_node ); # is always set 




1790




 





 





 





 





 





 



     my $row_domain_node = $builder->_row_domain_of_node( $table_node ); # may be undefined 




1791




 





 





 





 





 





 



     for my $row_field_node (@{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}) { 




1792




 





 





 





 





 





 



         my $table_field_name = $builder->build_identifier_element( $row_field_node ); 




1793




 





 





 





 





 





 



         if (!exists $col_name_cache{$row_field_node->get_self_id()}) { 




1794




 





 





 





 





 





 



             $col_name_cache{$row_field_node->get_self_id()} = $table_field_name; 




1795




 





 





 





 





 





 



         } 




1796




 





 





 





 





 





 



         my $scalar_data_type_node = $row_field_node->get_attribute( 'scalar_data_type' ); 




1797




 





 





 





 





 





 



         my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( 




1798




 





 





 





 





 





 



             $row_domain_node ? $builder->find_scalar_domain_for_row_domain_field( 




1799




 





 





 





 





 





 



             $scalar_data_type_node, $row_domain_node ) : $scalar_data_type_node ); 




1800




 





 





 





 





 





 



         my $table_field_sql_item = $table_field_name . ' ' . $dt_or_dom_sql; 




1801




 





 





 





 





 





 



         if (my $table_field_node = $table_fields_by_row_field{$row_field_node->get_self_id()}) { 




1802




 





 





 





 





 





 



             my $mandatory = $table_field_node->get_attribute( 'mandatory' ); 




1803




 





 





 





 





 





 



             $mandatory and $mandatory_field_cache{$row_field_node->get_self_id()} = 1; 




1804




 





 





 





 





 





 



             my $default_val = $table_field_node->get_attribute( 'default_val' ); 




1805




 





 





 





 





 





 



             my $auto_inc = $table_field_node->get_attribute( 'auto_inc' ); 




1806




 





 





 





 





 





 



             my $default_seq_node = $table_field_node->get_attribute( 'default_seq' ); 




1807




 





 





 





 





 





 



             $table_field_sql_item .= ($mandatory ? ' NOT NULL' : ' NULL') 




1808




 





 





 





 





 





 



                 . (defined $default_val ? ' DEFAULT ' . $builder->quote_literal( 




1809




 





 





 





 





 





 



                     $default_val, $scalar_data_type_node->get_attribute( 'base_type' ) ) : $EMPTY_STR) 




1810




 





 





 





 





 





 



                 . ($auto_inc ? ' AUTO_INCREMENT' : $EMPTY_STR) 




1811




 





 





 





 





 





 



                 . ($default_seq_node ? ' DEFAULT ' 




1812




 





 





 





 





 





 



                     . $builder->build_expr_seq_next( $default_seq_node ) : $EMPTY_STR); 




1813




 





 





 





 





 





 



         } 




1814




 





 





 





 





 





 



         else { 




1815




 





 





 





 





 





 



             $table_field_sql_item .= ' NULL'; 




1816




 





 





 





 





 





 



         } 




1817




 





 





 





 





 





 



         push @table_field_sql, $table_field_sql_item; 




1818




 





 





 





 





 





 



     } 




1819




 





 





 





 





 





 



     my @table_index_sql = (); 




1820




 





 





 





 





 





 



     my $pk_is_made = 0; 




1821




 





 





 





 





 





 



     for my $table_index_node (@{$table_node->get_child_nodes( 'table_index' )}) { 




1822




 





 





 





 





 





 



         my $table_index_name = $builder->build_identifier_element( $table_index_node ); 




1823




 





 





 





 





 





 



         my $index_type = $table_index_node->get_attribute( 'index_type' ); 




1824




 





 





 





 





 





 



         my @table_index_field_nodes = @{$table_index_node->get_child_nodes( 'table_index_field' )}; 




1825




 





 





 





 





 





 



         my $local_field_names_sql = join q{, }, map { 




1826




 





 





 





 





 





 



                 $col_name_cache{$_->get_attribute( 'si_field' )->get_self_id()} 




1827




 





 





 





 





 





 



             } @table_index_field_nodes; 




1828




 





 





 





 





 





 



         if ($index_type eq 'ATOMIC') { 




1829




 





 





 





 





 





 



             push @table_index_sql, 'INDEX ' . $table_index_name . ' (' . $local_field_names_sql . ')'; 




1830




 





 





 





 





 





 



         } 




1831




 





 





 





 





 





 



         if ($index_type eq 'FULLTEXT') { 




1832




 





 





 





 





 





 



             push @table_index_sql, 'FULLTEXT INDEX ' . $table_index_name . ' (' . $local_field_names_sql . ')'; 




1833




 





 





 





 





 





 



         } 




1834




 





 





 





 





 





 



         if ($index_type eq 'UNIQUE' or $index_type eq 'UFOREIGN') { 




1835




 





 





 





 





 





 



             my $make_a_pk_now = 0; 




1836




 





 





 





 





 





 



             if (!$pk_is_made) { 




1837




 





 





 





 





 





 



                 # All component columns of a primary key must be mandatory; check for it. 




1838




 





 





 





 





 





 



                 $make_a_pk_now = all { 




1839




 





 





 





 





 





 



                         $mandatory_field_cache{ $_->get_attribute( 'si_field' )->get_self_id() } 




1840




 





 





 





 





 





 



                     } @table_index_field_nodes; 




1841




 





 





 





 





 





 



             } 




1842




 





 





 





 





 





 



             if ($make_a_pk_now) { 




1843




 





 





 





 





 





 



                 push @table_index_sql, 'CONSTRAINT PRIMARY KEY (' . $local_field_names_sql . ')'; 




1844




 





 





 





 





 





 



             } 




1845




 





 





 





 





 





 



             else { 




1846




 





 





 





 





 





 



                 push @table_index_sql, 'CONSTRAINT ' . $table_index_name . ' UNIQUE' 




1847




 





 





 





 





 





 



                     . ' (' . $local_field_names_sql . ')'; # standard does not say INDEX after UNIQUE 




1848




 





 





 





 





 





 



             } 




1849




 





 





 





 





 





 



         } 




1850




 





 





 





 





 





 



         if ($index_type eq 'FOREIGN' or $index_type eq 'UFOREIGN') { 




1851




 





 





 





 





 





 



             my $foreign_table_name = $builder->build_identifier_schema_or_app_obj( 




1852




 





 





 





 





 





 



                 $table_index_node->get_attribute( 'f_table' ) ); 




1853




 





 





 





 





 





 



             my $foreign_field_names_sql = join q{, }, map { 




1854




 





 





 





 





 





 



                     $builder->build_identifier_element( $_->get_attribute( 'f_field' ) ) 




1855




 





 





 





 





 





 



                 } @table_index_field_nodes; 




1856




 





 





 





 





 





 



             push @table_index_sql, 'CONSTRAINT ' . $table_index_name . ' FOREIGN KEY' 




1857




 





 





 





 





 





 



                 . ' (' . $local_field_names_sql . ') REFERENCES ' . $foreign_table_name 




1858




 





 





 





 





 





 



                 . ' (' . $foreign_field_names_sql . ')'; 




1859




 





 





 





 





 





 



         } 




1860




 





 





 





 





 





 



     } 




1861




 





 





 





 





 





 



     my $is_temp = ($table_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1862




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' TABLE ' . $table_name 




1863




 





 





 





 





 





 



            . ' (' . "\n" . (join q{, } . "\n", @table_field_sql, @table_index_sql) . "\n" . ');' . "\n"; 




1864




 





 





 





 





 





 



 } 




1865




 





 





 





 





 





 



   




1866




 





 





 





 





 





 



 sub build_schema_or_app_table_delete { # SQL:2003, 11.21 "" (p587) 




1867




 





 





 





 





 





 



     my ($builder, $table_node) = @_; 




1868




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_table_delete', 




1869




 





 





 





 





 





 



         'TABLE_NODE', ['table'], $table_node ); 




1870




 





 





 





 





 





 



     my $table_name = $builder->build_identifier_schema_or_app_obj( $table_node, 1 ); 




1871




 





 





 





 





 





 



     return 'DROP TABLE ' . $table_name . ';' . "\n"; 




1872




 





 





 





 





 





 



 } 




1873




 





 





 





 





 





 



   




1874




 





 





 





 





 





 



 ###################################################################### 




1875




 





 





 





 





 





 



   




1876




 





 





 





 





 





 



 sub build_schema_or_app_view_create { # SQL:2003, 11.22 "" (p590) 




1877




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1878




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_view_create', 




1879




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1880




 





 





 





 





 





 



     my $view_name = $builder->build_identifier_schema_or_app_obj( $view_node, 1 ); 




1881




 





 





 





 





 





 



     my $query_expression = $builder->build_query_query_expr( $view_node ); 




1882




 





 





 





 





 





 



     my $is_temp = ($view_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1883




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' VIEW ' . $view_name . ' AS ' . $query_expression . ';' . "\n"; 




1884




 





 





 





 





 





 



     # Note: Several interesting looking features are not implemented yet. 




1885




 





 





 





 





 





 



 } 




1886




 





 





 





 





 





 



   




1887




 





 





 





 





 





 



 sub build_schema_or_app_view_delete { # SQL:2003, 11.23 "" (p600) 




1888




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1889




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_view_delete', 




1890




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1891




 





 





 





 





 





 



     my $view_name = $builder->build_identifier_schema_or_app_obj( $view_node, 1 ); 




1892




 





 





 





 





 





 



     return 'DROP VIEW ' . $view_name . ';' . "\n"; 




1893




 





 





 





 





 





 



 } 




1894




 





 





 





 





 





 



   




1895




 





 





 





 





 





 



 ###################################################################### 




1896




 





 





 





 





 





 



   




1897




 





 





 





 





 





 



 sub build_schema_or_app_routine_create { 




1898




 





 





 





 





 





 



     # SQL:2003, 11.39 "" (p629) 




1899




 





 





 





 





 





 



     # SQL:2003, 11.50 "" (p675) 




1900




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




1901




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_routine_create', 




1902




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




1903




 





 





 





 





 





 



     my $routine_type = $routine_node->get_attribute( 'routine_type' ); 




1904




 





 





 





 





 





 



     my $routine_name = $builder->build_identifier_schema_or_app_obj( $routine_node, 1 ); 




1905




 





 





 





 





 





 



     my $is_temp = ($routine_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1906




 





 





 





 





 





 



     if ($routine_type eq 'PACKAGE') { 




1907




 





 





 





 





 





 



         # Not implemented yet. 




1908




 





 





 





 





 





 



     } 




1909




 





 





 





 





 





 



     elsif ($routine_type eq 'TRIGGER') { 




1910




 





 





 





 





 





 



         my $table_or_view_name = $builder->build_identifier_schema_or_app_obj( 




1911




 





 





 





 





 





 



             $routine_node->get_attribute( 'trigger_on' ) ); 




1912




 





 





 





 





 





 



         my $trigger_event = $routine_node->get_attribute( 'trigger_event' ); 




1913




 





 





 





 





 





 



         my $trigger_event_sql 




1914




 





 





 





 





 





 



             = $trigger_event eq 'BEFR_INS' ? 'BEFORE INSERT' 




1915




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_INS' ? 'AFTER INSERT' 




1916




 





 





 





 





 





 



             : $trigger_event eq 'INST_INS' ? 'INSTEAD OF INSERT' 




1917




 





 





 





 





 





 



             : $trigger_event eq 'BEFR_UPD' ? 'BEFORE UPDATE' 




1918




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_UPD' ? 'AFTER UPDATE' 




1919




 





 





 





 





 





 



             : $trigger_event eq 'INST_UPD' ? 'INSTEAD OF UPDATE' 




1920




 





 





 





 





 





 



             : $trigger_event eq 'BEFR_DEL' ? 'BEFORE DELETE' 




1921




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_DEL' ? 'AFTER DELETE' 




1922




 





 





 





 





 





 



             : $trigger_event eq 'INST_DEL' ? 'INSTEAD OF DELETE' 




1923




 





 





 





 





 





 



             :                                undef # we should never get here 




1924




 





 





 





 





 





 



             ; 




1925




 





 





 





 





 





 



             # Note: INSTEAD OF is not standard SQL, but supported by SQLServer 2000, maybe Oracle, ?. 




1926




 





 





 





 





 





 



         my $for_each_stmt = $routine_node->get_attribute( 'trigger_per_stmt' ); 




1927




 





 





 





 





 





 



         # TODO: Implement optional OF . 




1928




 





 





 





 





 





 



         my @transition_var_names = (); # TODO: NEW/OLD ROW AS <... variable name> 




1929




 





 





 





 





 





 



         my $triggered_sql_statement = $builder->build_dmanip_routine_body( $routine_node, 1 ); 




1930




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' TRIGGER ' . $routine_name . ' ' 




1931




 





 





 





 





 





 



             . $trigger_event_sql . ' ON ' . $table_or_view_name 




1932




 





 





 





 





 





 



             . (@transition_var_names ? ' REFERENCING ' . (join ' ', @transition_var_names) : $EMPTY_STR) 




1933




 





 





 





 





 





 



             . ($for_each_stmt ? ' FOR EACH STATEMENT' : ' FOR EACH ROW') 




1934




 





 





 





 





 





 



             # TODO: WHEN (  ) 




1935




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1936




 





 





 





 





 





 



             . $triggered_sql_statement 




1937




 





 





 





 





 





 



             . ';' . "\n"; 




1938




 





 





 





 





 





 



     } 




1939




 





 





 





 





 





 



     elsif ($routine_type eq 'PROCEDURE') { 




1940




 





 





 





 





 





 



         my $routine_args = $builder->build_dmanip_routine_args( $routine_node ); 




1941




 





 





 





 





 





 



         # TODO:  where appropriate. 




1942




 





 





 





 





 





 



         my $routine_body = $builder->build_dmanip_routine_body( $routine_node ); 




1943




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' PROCEDURE ' . $routine_name 




1944




 





 





 





 





 





 



             . $routine_args 




1945




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1946




 





 





 





 





 





 



             . ' ' . $routine_body . ';' . "\n"; 




1947




 





 





 





 





 





 



     } 




1948




 





 





 





 





 





 



     elsif ($routine_type eq 'FUNCTION') { 




1949




 





 





 





 





 





 



         my $routine_args = $builder->build_dmanip_routine_args( $routine_node ); 




1950




 





 





 





 





 





 



         # TODO:  where appropriate. 




1951




 





 





 





 





 





 



         my $routine_body = $builder->build_dmanip_routine_body( $routine_node ); 




1952




 





 





 





 





 





 



         my $return_cont_type = $routine_node->get_attribute( 'return_cont_type' ); 




1953




 





 





 





 





 





 



         my $return_data_type = $EMPTY_STR; 




1954




 





 





 





 





 





 



         if ($return_cont_type eq 'ERROR') { 




1955




 





 





 





 





 





 



             # Not implemented yet. 




1956




 





 





 





 





 





 



         } 




1957




 





 





 





 





 





 



         elsif ($return_cont_type eq 'SCALAR') { 




1958




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_scalar_data_type' ); 




1959




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




1960




 





 





 





 





 





 



         } 




1961




 





 





 





 





 





 



         elsif ($return_cont_type eq 'ROW') { 




1962




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_row_data_type' ); 




1963




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




1964




 





 





 





 





 





 



         } 




1965




 





 





 





 





 





 



         elsif ($return_cont_type eq 'SC_ARY') { 




1966




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_scalar_data_type' ); 




1967




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ) . ' ARRAY'; 




1968




 





 





 





 





 





 



         } 




1969




 





 





 





 





 





 



         elsif ($return_cont_type eq 'RW_ARY') { 




1970




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_row_data_type' ); 




1971




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ) . ' ARRAY'; 




1972




 





 





 





 





 





 



         } 




1973




 





 





 





 





 





 



         elsif ($return_cont_type eq 'CONN') { 




1974




 





 





 





 





 





 



             # Not implemented yet. 




1975




 





 





 





 





 





 



         } 




1976




 





 





 





 





 





 



         elsif ($return_cont_type eq 'CURSOR') { 




1977




 





 





 





 





 





 



             # Not implemented yet. 




1978




 





 





 





 





 





 



         } 




1979




 





 





 





 





 





 



         elsif ($return_cont_type eq 'LIST') { 




1980




 





 





 





 





 





 



             # Not implemented yet. 




1981




 





 





 





 





 





 



         } 




1982




 





 





 





 





 





 



         else {} 




1983




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' FUNCTION ' . $routine_name 




1984




 





 





 





 





 





 



             . $routine_args 




1985




 





 





 





 





 





 



             . ' RETURNS ' . $return_data_type 




1986




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1987




 





 





 





 





 





 



             . ' ' . $routine_body . ';' . "\n"; 




1988




 





 





 





 





 





 



     } 




1989




 





 





 





 





 





 



     else {} # $routine_type eq 'BLOCK' 




1990




 





 





 





 





 





 



         # 'BLOCK': no-op; you should call build_dmanip_routine_body() directly instead 




1991




 





 





 





 





 





 



 } 




1992




 





 





 





 





 





 



   




1993




 





 





 





 





 





 



 sub build_schema_or_app_routine_delete { 




1994




 





 





 





 





 





 



     # SQL:2003, 11.40 "" (p633) 




1995




 





 





 





 





 





 



     # SQL:2003, 11.52 "" (p703) 




1996




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




1997




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_routine_delete', 




1998




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




1999




 





 





 





 





 





 



     my $routine_type = $routine_node->get_attribute( 'routine_type' ); 




2000




 





 





 





 





 





 



     my $routine_name = $builder->build_identifier_schema_or_app_obj( $routine_node, 1 ); 




2001




 





 





 





 





 





 



     # Note: 10.6 "" (p499) may be useful later. 




2002




 





 





 





 





 





 



     if ($routine_type eq 'PACKAGE') { 




2003




 





 





 





 





 





 



         # Not implemented yet. 




2004




 





 





 





 





 





 



     } 




2005




 





 





 





 





 





 



     elsif ($routine_type eq 'TRIGGER') { 




2006




 





 





 





 





 





 



         return 'DROP TRIGGER ' . $routine_name . ';' . "\n"; 




2007




 





 





 





 





 





 



     } 




2008




 





 





 





 





 





 



     elsif ($routine_type eq 'PROCEDURE') { 




2009




 





 





 





 





 





 



         return 'DROP PROCEDURE ' . $routine_name . ';' . "\n"; 




2010




 





 





 





 





 





 



     } 




2011




 





 





 





 





 





 



     elsif ($routine_type eq 'FUNCTION') { 




2012




 





 





 





 





 





 



         return 'DROP FUNCTION ' . $routine_name . ';' . "\n"; 




2013




 





 





 





 





 





 



     } 




2014




 





 





 





 





 





 



     else {} # $routine_type eq 'BLOCK'; no-op 




2015




 





 





 





 





 





 



 } 




2016




 





 





 





 





 





 



   




2017




 





 





 





 





 





 



 ###################################################################### 




2018




 





 





 





 





 





 



   




2019




 





 





 





 





 





 



 sub build_access_role_create { # SQL:2003, 12.4 "" (p743) 




2020




 





 





 





 





 





 



     my ($builder, $role_node) = @_; 




2021




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_role_create', 




2022




 





 





 





 





 





 



         'ROLE_NODE', ['role'], $role_node ); 




2023




 





 





 





 





 





 



     my $role_name = $builder->build_identifier_element( $role_node ); 




2024




 





 





 





 





 





 



     return 'CREATE ROLE ' . $role_name . ';' . "\n"; 




2025




 





 





 





 





 





 



 } 




2026




 





 





 





 





 





 



   




2027




 





 





 





 





 





 



 sub build_access_role_delete { # SQL:2003, 12.6 "" (p746) 




2028




 





 





 





 





 





 



     my ($builder, $role_node) = @_; 




2029




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_role_delete', 




2030




 





 





 





 





 





 



         'ROLE_NODE', ['role'], $role_node ); 




2031




 





 





 





 





 





 



     my $role_name = $builder->build_identifier_element( $role_node ); 




2032




 





 





 





 





 





 



     return 'DROP ROLE ' . $role_name . ';' . "\n"; 




2033




 





 





 





 





 





 



 } 




2034




 





 





 





 





 





 



   




2035




 





 





 





 





 





 



 ###################################################################### 




2036




 





 





 





 





 





 



   




2037




 





 





 





 





 





 



 sub build_access_grant { 




2038




 





 





 





 





 





 



     # Function returns empty string if given grantee has no privileges. 




2039




 





 





 





 





 





 



     # SQL:2003, 12.1 "" (p731) 




2040




 





 





 





 





 





 



     # SQL:2003, 12.2 "" (p736) 




2041




 





 





 





 





 





 



     # SQL:2003, 12.3 "" (p739) 




2042




 





 





 





 





 





 



     # SQL:2003, 12.5 "" (p744) 




2043




 





 





 





 





 





 



     my ($builder, $grantee_node) = @_; 




2044




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_grant', 




2045




 





 





 





 





 





 



         'GRANTEE_NODE', ['role','user'], $grantee_node ); 




2046




 





 





 





 





 





 



     my $node_type = $grantee_node->get_node_type(); 




2047




 





 





 





 





 





 



     my $grantee_name = $builder->build_identifier_schema_or_app_obj( $grantee_node ); 




2048




 





 





 





 





 





 



     if ($node_type eq 'role') { 




2049




 





 





 





 





 





 



         my @grant_stmts = (); 




2050




 





 





 





 





 





 



         for my $priv_on_node (@{$grantee_node->get_child_nodes( 'privilege_on' )}) { 




2051




 





 





 





 





 





 



             my $object_node = $priv_on_node->get_attribute( 'si_priv_on' ); 




2052




 





 





 





 





 





 



             my $object_name = $builder->build_identifier_schema_or_app_obj( $object_node ); 




2053




 





 





 





 





 





 



             my @priv_types = map { $_->get_attribute( 'si_priv_type' ) } 




2054




 





 





 





 





 





 



                 @{$priv_on_node->get_child_nodes( 'privilege_for' )}; 




2055




 





 





 





 





 





 



             my @object_privs = (); 




2056




 





 





 





 





 





 



             if (grep { $_ eq 'ALL' } @priv_types) { 




2057




 





 





 





 





 





 



                 push @object_privs, 'ALL PRIVILEGES'; 




2058




 





 





 





 





 





 



             } 




2059




 





 





 





 





 





 



             else { 




2060




 





 





 





 





 





 



                 for my $priv_type (@priv_types) { 




2061




 





 





 





 





 





 



                     push @object_privs, 




2062




 





 





 





 





 





 



                            $priv_type eq 'SELECT' ? 'SELECT' # TODO: allow only specific columns 




2063




 





 





 





 





 





 



                          : $priv_type eq 'DELETE' ? 'DELETE' 




2064




 





 





 





 





 





 



                          : $priv_type eq 'INSERT' ? 'INSERT' # TODO: allow only specific columns 




2065




 





 





 





 





 





 



                          : $priv_type eq 'UPDATE' ? 'UPDATE' # TODO: allow only specific columns 




2066




 





 





 





 





 





 



                          :                          $EMPTY_STR # TODO: REFERENCES, USAGE, TRIGGER, UNDER, EXECUTE; what do they mean? 




2067




 





 





 





 





 





 



                          ; 




2068




 





 





 





 





 





 



                 } 




2069




 





 





 





 





 





 



             } 




2070




 





 





 





 





 





 



             push @grant_stmts, 'GRANT ' . (join q{, }, @object_privs) 




2071




 





 





 





 





 





 



                 . ' ON ' . $object_name . ' TO ' . $grantee_name . ';'; 




2072




 





 





 





 





 





 



         } 




2073




 





 





 





 





 





 



         return join $EMPTY_STR, @grant_stmts; 




2074




 





 





 





 





 





 



     } 




2075




 





 





 





 





 





 



     elsif ($node_type eq 'user') { 




2076




 





 





 





 





 





 



         my @role_names = map { $builder->build_identifier_schema_or_app_obj( $_ ) } 




2077




 





 





 





 





 





 



             @{$grantee_node->get_child_nodes( 'user_role' )}; 




2078




 





 





 





 





 





 



         return @role_names ? 'GRANT ' . (join q{, }, @role_names) . ' TO ' . $grantee_name . ';' : $EMPTY_STR; 




2079




 





 





 





 





 





 



     } 




2080




 





 





 





 





 





 



     else {} 




2081




 





 





 





 





 





 



 } 




2082




 





 





 





 





 





 



   




2083




 





 





 





 





 





 



 sub build_access_revoke { 




2084




 





 





 





 





 





 



     # SQL:2003, 12.7 "" (p747) 




2085




 





 





 





 





 





 



     # SQL:2003, 12.3 "" (p739) 




2086




 





 





 





 





 





 



     my ($builder, $grantee_node) = @_; 




2087




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_revoke', 




2088




 





 





 





 





 





 



         'GRANTEE_NODE', ['role','user'], $grantee_node ); 




2089




 





 





 





 





 





 



     my $node_type = $grantee_node->get_node_type(); 




2090




 





 





 





 





 





 



     my $grantee_name = $builder->build_identifier_schema_or_app_obj( $grantee_node ); 




2091




 





 





 





 





 





 



     if ($node_type eq 'role') { 




2092




 





 





 





 





 





 



         my @revoke_stmts = (); 




2093




 





 





 





 





 





 



         for my $priv_on_node (@{$grantee_node->get_child_nodes( 'privilege_on' )}) { 




2094




 





 





 





 





 





 



             my $object_node = $priv_on_node->get_attribute( 'si_priv_on' ); 




2095




 





 





 





 





 





 



             my $object_name = $builder->build_identifier_schema_or_app_obj( $object_node ); 




2096




 





 





 





 





 





 



             push @revoke_stmts, 'REVOKE ALL PRIVILEGES' 




2097




 





 





 





 





 





 



                 . ' ON ' . $object_name . ' FROM ' . $grantee_name . ';'; 




2098




 





 





 





 





 





 



         } 




2099




 





 





 





 





 





 



         return join $EMPTY_STR, @revoke_stmts; 




2100




 





 





 





 





 





 



     } 




2101




 





 





 





 





 





 



     elsif ($node_type eq 'user') { 




2102




 





 





 





 





 





 



         my @role_names = map { $builder->build_identifier_schema_or_app_obj( $_ ) } 




2103




 





 





 





 





 





 



             @{$grantee_node->get_child_nodes( 'user_role' )}; 




2104




 





 





 





 





 





 



         return @role_names ? 'REVOKE ' . (join q{, }, @role_names) . ' FROM ' . $grantee_name . ';' : $EMPTY_STR; 




2105




 





 





 





 





 





 



     } 




2106




 





 





 





 





 





 



     else {} 




2107




 





 





 





 





 





 



 } 




2108




 





 





 





 





 





 



   




2109




 





 





 





 





 





 



 ###################################################################### 




2110




 





 





 





 





 





 



   




2111




 





 





 





 





 





 



 sub build_dmanip_routine_args { 




2112




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




2113




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_args', 




2114




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




2115




 





 





 





 





 





 



     # SQL:2003, 11.50 "" (p675) 




2116




 





 





 





 





 





 



     # in particular see  




2117




 





 





 





 





 





 



     my @rtn_arg_declare_sql = (); 




2118




 





 





 





 





 





 



     for my $rtn_arg_node (@{$routine_node->get_child_nodes( 'routine_arg' )}) { 




2119




 





 





 





 





 





 



         # TODO:  ::= IN | OUT | INOUT 




2120




 





 





 





 





 





 



         my $arg_name = $builder->build_identifier_element( $rtn_arg_node ); 




2121




 





 





 





 





 





 



         my $cont_type = $rtn_arg_node->get_attribute( 'cont_type' ); 




2122




 





 





 





 





 





 



         if ($cont_type eq 'ERROR') { 




2123




 





 





 





 





 





 



             # Not implemented yet. 




2124




 





 





 





 





 





 



         } 




2125




 





 





 





 





 





 



         elsif ($cont_type eq 'SCALAR') { 




2126




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'scalar_data_type' ); 




2127




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2128




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ';'; 




2129




 





 





 





 





 





 



         } 




2130




 





 





 





 





 





 



         elsif ($cont_type eq 'ROW') { 




2131




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'row_data_type' ); 




2132




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2133




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ';'; 




2134




 





 





 





 





 





 



         } 




2135




 





 





 





 





 





 



         elsif ($cont_type eq 'SC_ARY') { 




2136




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'scalar_data_type' ); 




2137




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2138




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2139




 





 





 





 





 





 



         } 




2140




 





 





 





 





 





 



         elsif ($cont_type eq 'RW_ARY') { 




2141




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'row_data_type' ); 




2142




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2143




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2144




 





 





 





 





 





 



         } 




2145




 





 





 





 





 





 



         elsif ($cont_type eq 'CONN') { 




2146




 





 





 





 





 





 



             # Not implemented yet. 




2147




 





 





 





 





 





 



         } 




2148




 





 





 





 





 





 



         elsif ($cont_type eq 'CURSOR') { 




2149




 





 





 





 





 





 



             # Not implemented yet. 




2150




 





 





 





 





 





 



         } 




2151




 





 





 





 





 





 



         elsif ($cont_type eq 'LIST') { 




2152




 





 





 





 





 





 



             # Not implemented yet. 




2153




 





 





 





 





 





 



         } 




2154




 





 





 





 





 





 



         else {} 




2155




 





 





 





 





 





 



     } 




2156




 





 





 





 





 





 



     return @rtn_arg_declare_sql ? '(' . (join q{, }, @rtn_arg_declare_sql) . ')' : $EMPTY_STR; 




2157




 





 





 





 





 





 



 } 




2158




 





 





 





 





 





 



   




2159




 





 





 





 





 





 



 sub build_dmanip_routine_body { 




2160




 





 





 





 





 





 



     # Corresponds to these sections: 




2161




 





 





 





 





 





 



     # ? 




2162




 





 





 





 





 





 



     # SQL:2003, 6.1 "" (p161) 




2163




 





 





 





 





 





 



     # SQL:2003, 13.5 "" (p790) 




2164




 





 





 





 





 





 



     # SQL:2003, 14.1 "" (p809) 




2165




 





 





 





 





 





 



     my ($builder, $routine_node, $is_atomic) = @_; 




2166




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_body', 




2167




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




2168




 





 





 





 





 





 



     my $is_ora_routines = $builder->{$PROP_ORA_ROUTINES}; 




2169




 





 





 





 





 





 



     my @rtn_var_declare_sql = (); 




2170




 





 





 





 





 





 



     for my $rtn_var_node (@{$routine_node->get_child_nodes( 'routine_var' )}) { 




2171




 





 





 





 





 





 



         my $var_name = $builder->build_identifier_element( $rtn_var_node ); 




2172




 





 





 





 





 





 



         my $cont_type = $rtn_var_node->get_attribute( 'cont_type' ); 




2173




 





 





 





 





 





 



         if ($cont_type eq 'ERROR') { 




2174




 





 





 





 





 





 



             # Not implemented yet. 




2175




 





 





 





 





 





 



         } 




2176




 





 





 





 





 





 



         elsif ($cont_type eq 'SCALAR') { 




2177




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'scalar_data_type' ); 




2178




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2179




 





 





 





 





 





 



             my $init_lit_val = $rtn_var_node->get_attribute( 'init_lit_val' ); 




2180




 





 





 





 





 





 



             my $is_constant = $rtn_var_node->get_attribute( 'is_constant' ); 




2181




 





 





 





 





 





 



             push @rtn_var_declare_sql, 




2182




 





 





 





 





 





 



                 ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') 




2183




 





 





 





 





 





 



                 . $var_name . ' ' . $dt_or_dom_sql 




2184




 





 





 





 





 





 



                 # TODO: use $is_constant 




2185




 





 





 





 





 





 



                 . (defined $init_lit_val ? ' DEFAULT ' . $builder->quote_literal( $init_lit_val, 




2186




 





 





 





 





 





 



                     $builder->_scalar_data_type_of_node( $rtn_var_node )->get_attribute( 'base_type' ) ) : $EMPTY_STR) 




2187




 





 





 





 





 





 



                 . ';' 




2188




 





 





 





 





 





 



             ; 




2189




 





 





 





 





 





 



         } 




2190




 





 





 





 





 





 



         elsif ($cont_type eq 'ROW') { 




2191




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'row_data_type' ); 




2192




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2193




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ';'; 




2194




 





 





 





 





 





 



         } 




2195




 





 





 





 





 





 



         elsif ($cont_type eq 'SC_ARY') { 




2196




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'scalar_data_type' ); 




2197




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2198




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2199




 





 





 





 





 





 



         } 




2200




 





 





 





 





 





 



         elsif ($cont_type eq 'RW_ARY') { 




2201




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'row_data_type' ); 




2202




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2203




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2204




 





 





 





 





 





 



         } 




2205




 





 





 





 





 





 



         elsif ($cont_type eq 'CONN') { 




2206




 





 





 





 





 





 



             # Not implemented yet. 




2207




 





 





 





 





 





 



         } 




2208




 





 





 





 





 





 



         elsif ($cont_type eq 'CURSOR') { 




2209




 





 





 





 





 





 



             if (my $view_node = (@{$rtn_var_node->get_child_nodes( 'view' )})[0]) { 




2210




 





 





 





 





 





 



                 # Since we got here, cursor will be defined within curr rtn, regardless of share or not. 




2211




 





 





 





 





 





 



                 my $query_expr = $builder->build_query_query_expr( $view_node ); 




2212




 





 





 





 





 





 



                 my $order_by_clause = $builder->build_query_window_clause( $view_node ); 




2213




 





 





 





 





 





 



                 my $updatability_clause 




2214




 





 





 





 





 





 



                     = $rtn_var_node->get_attribute( 'curs_for_update' ) ? 'FOR UPDATE' 




2215




 





 





 





 





 





 



                     :                                                     'FOR READ ONLY'; # TODO: [ OF  ] 




2216




 





 





 





 





 





 



                 # TODO: sensitivity, scrollability, holdability, returnability 




2217




 





 





 





 





 





 



                 my $cursor_spec = $query_expr . ' ' . $order_by_clause . ' ' . $updatability_clause; 




2218




 





 





 





 





 





 



                 push @rtn_var_declare_sql, 'DECLARE ' . $var_name . ' CURSOR FOR ' . $cursor_spec . ';'; 




2219




 





 





 





 





 





 



             } 




2220




 





 





 





 





 





 



             else { 




2221




 





 





 





 





 





 



                 # Not implemented yet; but also not sure of proper way to implement. 




2222




 





 





 





 





 





 



                 # If we got here then cursor had been declared in diff rtn and passed to curr one. 




2223




 





 





 





 





 





 



                 # We can't just make another copy of decl since may use vars/args/etc of other rtn. 




2224




 





 





 





 





 





 



                 push @rtn_var_declare_sql, 'DECLARE ' . $var_name . ';'; 




2225




 





 





 





 





 





 



             } 




2226




 





 





 





 





 





 



         } 




2227




 





 





 





 





 





 



         elsif ($cont_type eq 'LIST') { 




2228




 





 





 





 





 





 



             # Not implemented yet. 




2229




 





 





 





 





 





 



         } 




2230




 





 





 





 





 





 



         else {} 




2231




 





 





 





 





 





 



     } 




2232




 





 





 





 





 





 



     my @rtn_stmt_sql = (); 




2233




 





 





 





 





 





 



     for my $rtn_stmt_node (@{$routine_node->get_child_nodes( 'routine_stmt' )}) { 




2234




 





 





 





 





 





 



         push @rtn_stmt_sql, $builder->build_dmanip_routine_stmt( $rtn_stmt_node ); 




2235




 





 





 





 





 





 



     } 




2236




 





 





 





 





 





 



     my $atomic_clause = $is_atomic ? 'ATOMIC ' : $EMPTY_STR; 




2237




 





 





 





 





 





 



     return join ' ', 




2238




 





 





 





 





 





 



         # TODO: proper handling of vars declared within 'BLOCK' routines, when in Oracle syntax. 




2239




 





 





 





 





 





 



         ($is_ora_routines ? 'VAR ' : 'BEGIN ' . $atomic_clause), 




2240




 





 





 





 





 





 



         @rtn_var_declare_sql, 




2241




 





 





 





 





 





 



         ($is_ora_routines ? 'BEGIN ' . $atomic_clause : $EMPTY_STR), 




2242




 





 





 





 





 





 



         @rtn_stmt_sql, 




2243




 





 





 





 





 





 



         'END;' 




2244




 





 





 





 





 





 



     ; 




2245




 





 





 





 





 





 



 } 




2246




 





 





 





 





 





 



   




2247




 





 





 





 





 





 



 ###################################################################### 




2248




 





 





 





 





 





 



   




2249




 





 





 





 





 





 



 sub build_dmanip_routine_stmt { 




2250




 





 





 





 





 





 



     # SQL:2003, 13.5 "" (p790) 




2251




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2252




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_stmt', 




2253




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2254




 





 





 





 





 





 



     if (my $compound_stmt_routine = $rtn_stmt_node->get_attribute( 'block_routine' )) { 




2255




 





 





 





 





 





 



         return $builder->build_dmanip_routine_body( $compound_stmt_routine ); 




2256




 





 





 





 





 





 



     } 




2257




 





 





 





 





 





 



     elsif (my $assign_dest_node = $rtn_stmt_node->get_attribute( 'assign_dest' ) || 




2258




 





 





 





 





 





 



             $rtn_stmt_node->get_attribute( 'assign_dest' )) { 




2259




 





 





 





 





 





 



         my $dest = $builder->build_identifier_element( $assign_dest_node ); 




2260




 





 





 





 





 





 



         my $src = $builder->build_expr( 




2261




 





 





 





 





 





 



             $rtn_stmt_node->get_child_nodes( 'routine_expr' )->[0] ); 




2262




 





 





 





 





 





 



         if ($builder->{$PROP_ORA_ROUTINES}) { 




2263




 





 





 





 





 





 



             return $dest . ' := ' . $src . ';' . "\n"; 




2264




 





 





 





 





 





 



         } 




2265




 





 





 





 





 





 



         else { 




2266




 





 





 





 





 





 



             return 'SET ' . $dest . ' = ' . $src . ';' . "\n"; 




2267




 





 





 





 





 





 



         } 




2268




 





 





 





 





 





 



     } 




2269




 





 





 





 





 





 



     elsif ($rtn_stmt_node->get_attribute( 'call_sroutine' )) { 




2270




 





 





 





 





 





 



         return $builder->build_dmanip_call_sroutine( $rtn_stmt_node ); 




2271




 





 





 





 





 





 



     } 




2272




 





 





 





 





 





 



     elsif ($rtn_stmt_node->get_attribute( 'call_uroutine' )) { 




2273




 





 





 





 





 





 



         return $builder->build_dmanip_call_uroutine( $rtn_stmt_node ); 




2274




 





 





 





 





 





 



     } 




2275




 





 





 





 





 





 



     else {} 




2276




 





 





 





 





 





 



 } 




2277




 





 





 





 





 





 



   




2278




 





 





 





 





 





 



 ###################################################################### 




2279




 





 





 





 





 





 



   




2280




 





 





 





 





 





 



 sub build_dmanip_call_sroutine { 




2281




 





 





 





 





 





 



     # Corresponds to these sections: 




2282




 





 





 





 





 





 



     # SQL:2003, 14.2 "" (p815) 




2283




 





 





 





 





 





 



     # SQL:2003, 14.3 "" (p817) 




2284




 





 





 





 





 





 



     # SQL:2003, 14.4 "" (p822) 




2285




 





 





 





 





 





 



     # SQL:2003, 15.2 "" (p886) 




2286




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2287




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_call_sroutine', 




2288




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2289




 





 





 





 





 





 



     my $sroutine = $rtn_stmt_node->get_attribute( 'call_sroutine' ); 




2290




 





 





 





 





 





 



     my %child_exprs = map { ( 




2291




 





 





 





 





 





 



             ($_->get_attribute( 'call_sroutine_cxt' ) || 




2292




 





 





 





 





 





 



                 $_->get_attribute( 'call_sroutine_arg' )) => $_ 




2293




 





 





 





 





 





 



         ) } @{$rtn_stmt_node->get_child_nodes( 'routine_expr' )}; 




2294




 





 





 





 





 





 



     if ($sroutine eq 'RETURN') { 




2295




 





 





 





 





 





 



         my $return_value = $builder->build_expr( $child_exprs{'RETURN_VALUE'} ); 




2296




 





 





 





 





 





 



         return 'RETURN ' . $return_value . ';' . "\n"; # no parens in standard 




2297




 





 





 





 





 





 



     } 




2298




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_OPEN') { # opens a select cursor for reading from (or performs a select if in right context) 




2299




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2300




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2301




 





 





 





 





 





 



         return 'OPEN ' . $cursor_cx_name . ';' . "\n"; 




2302




 





 





 





 





 





 



     } 




2303




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_CLOSE') { # closes a select cursor when you're done with it 




2304




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2305




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2306




 





 





 





 





 





 



         return 'CLOSE ' . $cursor_cx_name . ';' . "\n"; 




2307




 





 





 





 





 





 



     } 




2308




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_FETCH') { # reads a row from an opened cursor and puts it in a row/list variable 




2309




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2310




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2311




 





 





 





 





 





 



         my $fetch_orient = $EMPTY_STR; # TODO: the explicit  options; NEXT is default 




2312




 





 





 





 





 





 



         my $query_dest_name = $builder->build_identifier_element( 




2313




 





 





 





 





 





 



             $child_exprs{'INTO'}->get_attribute( 'query_dest' ) ); 




2314




 





 





 





 





 





 



         return 'FETCH ' . $fetch_orient . ' FROM ' . $cursor_cx_name . ' INTO ' . $query_dest_name . ';' . "\n"; 




2315




 





 





 





 





 





 



     } 




2316




 





 





 





 





 





 



     elsif ($sroutine eq 'SELECT') { # fetches one row from a table/view and puts it in a row/list variable 




2317




 





 





 





 





 





 



         my $view_node = $child_exprs{'SELECT_DEFN'}->get_attribute( 'act_on' ); 




2318




 





 





 





 





 





 



         return $builder->build_query_query_spec( $view_node, 




2319




 





 





 





 





 





 



             $child_exprs{'INTO'}->get_attribute( 'query_dest' ) ) . ';' . "\n"; 




2320




 





 





 





 





 





 



     } 




2321




 





 





 





 





 





 



     elsif ($sroutine eq 'INSERT') { # inserts a row into a table/view 




2322




 





 





 





 





 





 



         my $view_node = $child_exprs{'INSERT_DEFN'}->get_attribute( 'act_on' ); 




2323




 





 





 





 





 





 



         return $builder->build_dmanip_insert_stmt( $view_node ); 




2324




 





 





 





 





 





 



     } 




2325




 





 





 





 





 





 



     elsif ($sroutine eq 'UPDATE') { # updates a row in a table/view 




2326




 





 





 





 





 





 



         my $view_node = $child_exprs{'UPDATE_DEFN'}->get_attribute( 'act_on' ); 




2327




 





 





 





 





 





 



         return $builder->build_dmanip_update_stmt( $view_node ); 




2328




 





 





 





 





 





 



     } 




2329




 





 





 





 





 





 



     elsif ($sroutine eq 'DELETE') { # deletes a row in a table/view 




2330




 





 





 





 





 





 



         my $view_node = $child_exprs{'DELETE_DEFN'}->get_attribute( 'act_on' ); 




2331




 





 





 





 





 





 



         return $builder->build_dmanip_delete_stmt( $view_node ); 




2332




 





 





 





 





 





 



     } 




2333




 





 





 





 





 





 



     elsif ($sroutine eq 'COMMIT') { # commits the current transaction, then starts a new one 




2334




 





 





 





 





 





 



         return 'COMMIT; START TRANSACTION;' . "\n"; 




2335




 





 





 





 





 





 



         # Note: According to the MySQL manual: 




2336




 





 





 





 





 





 



         # For transaction-safe tables, there are actions (other than typing COMMIT) 




2337




 





 





 





 





 





 



         # that will automatically trigger a COMMIT. Requesting a lock will implicitly 




2338




 





 





 





 





 





 



         # commit any outstanding queries. 




2339




 





 





 





 





 





 



     } 




2340




 





 





 





 





 





 



     elsif ($sroutine eq 'ROLLBACK') { # rolls back the current transaction, then starts a new one 




2341




 





 





 





 





 





 



         return 'ROLLBACK; START TRANSACTION;' . "\n"; # TODO: rollback to a named save point only 




2342




 





 





 





 





 





 



     } 




2343




 





 





 





 





 





 



     else {} # There are a bunch more that aren't implemented yet. 




2344




 





 





 





 





 





 



 } 




2345




 





 





 





 





 





 



   




2346




 





 





 





 





 





 



 ###################################################################### 




2347




 





 





 





 





 





 



   




2348




 





 





 





 





 





 



 sub build_dmanip_src_schema_object_name { 




2349




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2350




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_src_schema_object_name', 




2351




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2352




 





 





 





 





 





 



     my $view_type = $view_node->get_attribute( 'view_type' ); 




2353




 





 





 





 





 





 



     my @view_src_nodes = @{$view_node->get_child_nodes( 'view_src' )}; 




2354




 





 





 





 





 





 



     if (@view_src_nodes == 0) { 




2355




 





 





 





 





 





 



         return; # No source at all. 




2356




 





 





 





 





 





 



     } 




2357




 





 





 





 





 





 



     elsif ($view_type eq 'ALIAS' or @view_src_nodes == 1) { 




2358




 





 





 





 





 





 



         my $object_node = $view_src_nodes[0]->get_attribute( 'match' ); 




2359




 





 





 





 





 





 



         if ($object_node->get_primary_parent_attribute()->get_node_type() eq 'schema') { 




2360




 





 





 





 





 





 



             # The only source is a schema object, table or named view; use it directly. 




2361




 





 





 





 





 





 



             return $builder->build_identifier_schema_or_app_obj( $object_node ); 




2362




 





 





 





 





 





 



         } 




2363




 





 





 





 





 





 



         else { 




2364




 





 





 





 





 





 



             # The only source seems to be a sub-query in "from". 




2365




 





 





 





 





 





 



             return; # Adding recursion in all necessary places too complicated for now. 




2366




 





 





 





 





 





 



         } 




2367




 





 





 





 





 





 



     } 




2368




 





 





 





 





 





 



     else { # @view_src_nodes >= 2 




2369




 





 





 





 





 





 



         return; # Manual updates against multiple sources too complicated for now. 




2370




 





 





 





 





 





 



     } 




2371




 





 





 





 





 





 



 } 




2372




 





 





 





 





 





 



   




2373




 





 





 





 





 





 



 ###################################################################### 




2374




 





 





 





 





 





 



   




2375




 





 





 





 





 





 



 sub build_dmanip_insert_stmt { 




2376




 





 





 





 





 





 



     # SQL:2003, 7.3 "" (p298) 




2377




 





 





 





 





 





 



     # SQL:2003, 14.8 "" (p834) 




2378




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2379




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_insert_stmt', 




2380




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2381




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2382




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2383




 





 





 





 





 





 



     my @set_expr_nodes 




2384




 





 





 





 





 





 



         = grep { $_->get_attribute( 'view_part' ) eq 'SET' } 




2385




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




2386




 





 





 





 





 





 



     my @set_fields_list = (); 




2387




 





 





 





 





 





 



     my @set_values_list = (); 




2388




 





 





 





 





 





 



     for my $expr_node (@set_expr_nodes) { 




2389




 





 





 





 





 





 



         push @set_fields_list, $builder->build_identifier_element( 




2390




 





 





 





 





 





 



             $expr_node->get_attribute( 'set_src_field' ) ); 




2391




 





 





 





 





 





 



         push @set_values_list, $builder->build_expr( $expr_node ); 




2392




 





 





 





 





 





 



     } 




2393




 





 





 





 





 





 



     my $insert_fields_and_src = '(' . (join q{, }, @set_fields_list) . ') ' 




2394




 





 





 





 





 





 



         . 'VALUES (' . (join q{, }, @set_values_list) . ')'; 




2395




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2396




 





 





 





 





 





 



     return 'INSERT INTO ' . $object_name . ' ' . $insert_fields_and_src . ';' . "\n"; 




2397




 





 





 





 





 





 



 } 




2398




 





 





 





 





 





 



   




2399




 





 





 





 





 





 



 ###################################################################### 




2400




 





 





 





 





 





 



   




2401




 





 





 





 





 





 



 sub build_dmanip_update_stmt { 




2402




 





 





 





 





 





 



     # SQL:2003, 14.11 "" (p849) 




2403




 





 





 





 





 





 



     # SQL:2003, 14.12 "" (p853) 




2404




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2405




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_update_stmt', 




2406




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2407




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2408




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2409




 





 





 





 





 





 



     my @set_expr_nodes 




2410




 





 





 





 





 





 



         = grep { $_->get_attribute( 'view_part' ) eq 'SET' } 




2411




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




2412




 





 





 





 





 





 



     my @set_clause_list = (); 




2413




 





 





 





 





 





 



     for my $expr_node (@set_expr_nodes) { 




2414




 





 





 





 





 





 



         my $set_target = $builder->build_identifier_element( 




2415




 





 





 





 





 





 



             $expr_node->get_attribute( 'set_src_field' ) ); 




2416




 





 





 





 





 





 



         my $update_source = $builder->build_expr( $expr_node ); 




2417




 





 





 





 





 





 



         push @set_clause_list, $set_target . ' = ' . $update_source; 




2418




 





 





 





 





 





 



     } 




2419




 





 





 





 





 





 



     my $set_clause = 'SET ' . (join q{, }, @set_clause_list); 




2420




 





 





 





 





 





 



     my $where_clause = $builder->build_query_where_clause( $view_node ); 




2421




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2422




 





 





 





 





 





 



     return 'UPDATE ' . $object_name . ' ' . $set_clause . ' ' . $where_clause . ';' . "\n"; 




2423




 





 





 





 





 





 



 } 




2424




 





 





 





 





 





 



   




2425




 





 





 





 





 





 



 ###################################################################### 




2426




 





 





 





 





 





 



   




2427




 





 





 





 





 





 



 sub build_dmanip_delete_stmt { # SQL:2003, 14.7 "" (p831) 




2428




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2429




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_delete_stmt', 




2430




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2431




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2432




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2433




 





 





 





 





 





 



     my $where_clause = $builder->build_query_where_clause( $view_node ); 




2434




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2435




 





 





 





 





 





 



     return 'DELETE FROM ' . $object_name . ' ' . $where_clause . ';' . "\n"; 




2436




 





 





 





 





 





 



 } 




2437




 





 





 





 





 





 



   




2438




 





 





 





 





 





 



 ###################################################################### 




2439




 





 





 





 





 





 



   




2440




 





 





 





 





 





 



 sub build_dmanip_call_uroutine { 




2441




 





 





 





 





 





 



     # SQL:2003 ...  ... 




2442




 





 





 





 





 





 



     # SQL:2003, 15.1 "" (p885) 




2443




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2444




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_call_uroutine', 




2445




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2446




 





 





 





 





 





 



     my $uroutine = $rtn_stmt_node->get_attribute( 'call_uroutine' ); 




2447




 





 





 





 





 





 



     my $uroutine_name = $builder->build_identifier_schema_or_app_obj( $uroutine ); 




2448




 





 





 





 





 





 



     my %uroutine_arg_exprs 




2449




 





 





 





 





 





 



         = map { ($_->get_attribute( 'call_uroutine_arg' )->get_self_id() => $_) } 




2450




 





 





 





 





 





 



           @{$rtn_stmt_node->get_child_nodes( 'routine_expr' )}; 




2451




 





 





 





 





 





 



     # Note: The build_expr() calls are done below to ensure the arg values are 




2452




 





 





 





 





 





 



     # defined in the same order they are output; this lets optional insertion 




2453




 





 





 





 





 





 



     # of positionally determined host params (and their mapping) to work right. 




2454




 





 





 





 





 





 



     my $arg_val_list = join q{, }, 




2455




 





 





 





 





 





 



         map { $uroutine_arg_exprs{$_->get_self_id()} 




2456




 





 





 





 





 





 



               ? $builder->build_expr( $uroutine_arg_exprs{$_->get_self_id()} ) 




2457




 





 





 





 





 





 



               : 'NULL' } 




2458




 





 





 





 





 





 



         @{$uroutine->get_child_nodes( 'routine_arg' )}; 




2459




 





 





 





 





 





 



     #  ::= CALL  




2460




 





 





 





 





 





 



     return 'CALL ' . $uroutine_name . ($arg_val_list ? '(' . $arg_val_list . ')' : $EMPTY_STR) . ';' . "\n"; 




2461




 





 





 





 





 





 



 } 




2462




 





 





 





 





 





 



   




2463




 





 





 





 





 





 



 ###################################################################### 




2464




 





 





 





 





 





 



   




2465




 





 





 





 





 





 



 sub substitute_macros { 




2466




 





 





 





 





 





 



     my ($builder, $str, $subs) = @_; 




2467




 





 





 





 





 





 



     while (my ($key,$value) = each %{$subs}) { 




2468




 





 





 





 





 





 



         $str =~ s/ \{ $key \} /$value/x; 




2469




 





 





 





 





 





 



     } 




2470




 





 





 





 





 





 



     return $str; 




2471




 





 





 





 





 





 



 } 




2472




 





 





 





 





 





 



   




2473




 





 





 





 





 





 



 ###################################################################### 




2474




 





 





 





 





 





 



   




2475




 





 





 





 





 





 



 sub find_scalar_domain_for_row_domain_field { 




2476




 





 





 





 





 





 



     my ($builder, $scalar_data_type_node, $row_domain_node) = @_; 




2477




 





 





 





 





 





 



     my @candidates = grep { $_->get_attribute( 'data_type' )->get_self_id() eq $scalar_data_type_node->get_self_id() } 




2478




 





 





 





 





 





 



         @{$row_domain_node->get_primary_parent_attribute()->get_child_nodes( 'scalar_domain' )}; 




2479




 





 





 





 





 





 



     return $candidates[0] || $scalar_data_type_node; 




2480




 





 





 





 





 





 



 } 




2481




 





 





 





 





 





 



   




2482




 





 





 





 





 





 



 ###################################################################### 




2483




 





 





 





 





 





 



   




2484




 





 





 





 





 





 



 sub _scalar_data_type_of_node { 




2485




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2486




 





 





 





 





 





 



     $atnm ||= 'scalar_data_type'; 




2487




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2488




 





 





 





 





 





 



     if ($dt_or_dom_node->get_node_type() eq 'scalar_domain') { 




2489




 





 





 





 





 





 



         $dt_or_dom_node = $dt_or_dom_node->get_attribute( 'data_type' ); 




2490




 





 





 





 





 





 



     } 




2491




 





 





 





 





 





 



     return $dt_or_dom_node; 




2492




 





 





 





 





 





 



 } 




2493




 





 





 





 





 





 



   




2494




 





 





 





 





 





 



 sub _row_data_type_of_node { 




2495




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2496




 





 





 





 





 





 



     $atnm ||= 'row_data_type'; 




2497




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2498




 





 





 





 





 





 



     if ($dt_or_dom_node->get_node_type() eq 'row_domain') { 




2499




 





 





 





 





 





 



         $dt_or_dom_node = $dt_or_dom_node->get_attribute( 'data_type' ); 




2500




 





 





 





 





 





 



     } 




2501




 





 





 





 





 





 



     return $dt_or_dom_node; 




2502




 





 





 





 





 





 



 } 




2503




 





 





 





 





 





 



   




2504




 





 





 





 





 





 



 sub _row_domain_of_node { 




2505




 





 





 





 





 





 



     # returns domain or nothing 




2506




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2507




 





 





 





 





 





 



     $atnm ||= 'row_data_type'; 




2508




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2509




 





 





 





 





 





 



     return $dt_or_dom_node 




2510




 





 





 





 





 





 



         if $dt_or_dom_node->get_node_type() eq 'row_domain'; 




2511




 





 





 





 





 





 



     return; 




2512




 





 





 





 





 





 



 } 




2513




 





 





 





 





 





 



   




2514




 





 





 





 





 





 



 ###################################################################### 




2515




 





 





 





 





 





 



 # This is a 'protected' method; only sub-classes should invoke it. 




2516




 





 





 





 





 





 



   




2517




 





 





 





 





 





 



 sub _throw_error_message { 




2518




 





 





 





 





 





 



     my ($builder, $msg_key, $msg_vars) = @_; 




2519




 





 





 





 





 





 



     # Throws an exception consisting of an object. 




2520




 





 





 





 





 





 



     ref $msg_vars eq 'HASH' or $msg_vars = {}; 




2521




 





 





 





 





 





 



     for my $var_key (keys %{$msg_vars}) { 




2522




 





 





 





 





 





 



         if (ref $msg_vars->{$var_key} eq 'ARRAY') { 




2523




 





 





 





 





 





 



             $msg_vars->{$var_key} = 'PERL_ARRAY:[' . (join q{,},map {$_||$EMPTY_STR} @{$msg_vars->{$var_key}}) . ']'; 




2524




 





 





 





 





 





 



         } 




2525




 





 





 





 





 





 



     } 




2526




 





 





 





 





 





 



     die Locale::KeyedText->new_message( $msg_key, $msg_vars ); 




2527




 





 





 





 





 





 



 } 




2528




 





 





 





 





 





 



   




2529




 





 





 





 





 





 



 sub _assert_arg_node_type { 




2530




 





 





 





 





 





 



     my ($builder, $meth_name, $arg_name, $exp_node_types, $arg_value) = @_; 




2531




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_UNDEF', 




2532




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name } ) 




2533




 





 





 





 





 





 



         if !defined $arg_value; 




2534




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_NO_NODE', 




2535




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name, 'ARGVL' => $arg_value } ) 




2536




 





 





 





 





 





 



         if !ref $arg_value or !UNIVERSAL::isa( $arg_value, 'Rosetta::Model::Node' ); 




2537




 





 





 





 





 





 



     return 




2538




 





 





 





 





 





 



         if @{$exp_node_types} == 0; # any Node type is acceptable 




2539




 





 





 





 





 





 



     my $given_node_type = $arg_value->get_node_type(); 




2540




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_WRONG_NODE_TYPE', 




2541




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name, 




2542




 





 





 





 





 





 



         'EXPNTYPE' => $exp_node_types, 'ARGNTYPE' => $given_node_type } ) 




2543




 





 





 





 





 





 



         if !grep { $given_node_type eq $_ } @{$exp_node_types}; 




2544




 





 





 





 





 





 



     # If we get here, $arg_value is acceptable to the method. 




2545




 





 





 





 





 





 



 } 




2546




 





 





 





 





 





 



   




2547




 





 





 





 





 





 



 ###################################################################### 




2548




 





 





 





 





 





 



 ###################################################################### 




2549




 





 





 





 





 





 



   




2550




 





 





 





 





 





 



 1; 




2551




 





 





 





 





 





 



 __END__
        # generated in appearance order, so positional host param mapping works right.
        # Note: This code isn't very smart and assumes that all the view_join Nodes
        # are declared in the same order they should be output, even if their is
        # other evidence to the contrary.  This code can be smartened later.
        # This code also assumes that the ROS M is correct, such that all defined
        # view_src Nodes are involved in a single common view_join; there should be
        # exactly one fewer view_join Node than there are view_src Nodes.
        # TODO: Support the Oracle-8 way of putting join conditions in WHERE.
        my @sql_fragment_list = ();
        push @sql_fragment_list, $builder->build_query_table_factor(
            $view_join_nodes[0]->get_attribute( 'lhs_src' ) );
        for my $view_join_node (@view_join_nodes) {
            my $join_op = $view_join_node->get_attribute( 'join_op' );
            push @sql_fragment_list, "\n"
                 . ( $join_op eq 'CROSS' ? 'CROSS JOIN'
                   : $join_op eq 'INNER' ? 'INNER JOIN'
                   : $join_op eq 'LEFT'  ? 'LEFT OUTER JOIN'
                   : $join_op eq 'RIGHT' ? 'RIGHT OUTER JOIN'
                   : $join_op eq 'FULL'  ? 'FULL OUTER JOIN'
                   :                       undef # we should never get here
                   );
            push @sql_fragment_list, $builder->build_query_table_factor(
                $view_join_node->get_attribute( 'rhs_src' ) );
            my @join_on_sql = ();
            for my $view_join_field_node (@{$view_join_node->get_child_nodes( 'view_join_field' )}) {
                my $lhs_src_field_name = $builder->build_identifier_view_src_field(
                    $view_join_field_node->get_attribute( 'lhs_src_field' ) );
                my $rhs_src_field_name = $builder->build_identifier_view_src_field(
                    $view_join_field_node->get_attribute( 'rhs_src_field' ) );
                push @join_on_sql, $rhs_src_field_name . ' = ' . $lhs_src_field_name;
            }
            push @sql_fragment_list, 'ON ' . (join ' AND ', @join_on_sql);
        }
        return "\n" . 'FROM ' . (join ' ', @sql_fragment_list);
    }
}

sub build_query_table_factor { # SQL:2003, 7.6 "" (p303) 




1373




 





 





 





 





 





 



     my ($builder, $view_src_node) = @_; 




1374




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_table_factor', 




1375




 





 





 





 





 





 



         'VIEW_SRC_NODE', ['view_src'], $view_src_node ); 




1376




 





 





 





 





 





 



     # Maybe TODO:  




1377




 





 





 





 





 





 



     my $correlation_name = $builder->build_identifier_element( $view_src_node ); 




1378




 





 





 





 





 





 



     my $match_node = $view_src_node->get_attribute( 'match' ); 




1379




 





 





 





 





 





 



     my $match_name = $builder->build_identifier_schema_or_app_obj( $match_node ); 




1380




 





 





 





 





 





 



     if ($match_node->get_node_type() eq 'view') { 




1381




 





 





 





 





 





 



         if ($match_node->get_primary_parent_attribute()->get_node_type() eq 'view') { 




1382




 





 





 





 





 





 



             # The view we are matching is a subquery. 




1383




 





 





 





 





 





 



             if ($builder->{$PROP_INLINE_SUBQ}) { 




1384




 





 





 





 





 





 



                 # Embed an anonymous subquery; argument passing is not yet supported. 




1385




 





 





 





 





 





 



                 my $query_expression = $builder->build_query_query_expr( $match_node ); 




1386




 





 





 





 





 





 



                 return '(' . $query_expression . ') AS ' . $correlation_name; 




1387




 





 





 





 





 





 



             } 




1388




 





 





 





 





 





 



             else { 




1389




 





 





 





 





 





 



                 # Call a named subquery; argument passing is supported. 




1390




 





 





 





 





 





 



                 my %src_args_to_view_exprs 




1391




 





 





 





 





 





 



                     = map { ($_->get_attribute( 'call_src_arg' )->get_self_id() => $_) } 




1392




 





 





 





 





 





 



                       grep { $_->get_attribute( 'view_part' ) eq 'FROM' } 




1393




 





 





 





 





 





 



                       @{$view_src_node->get_primary_parent_attribute()->get_child_nodes( 'view_expr' )}; 




1394




 





 





 





 





 





 



                 my %view_args_to_src_args 




1395




 





 





 





 





 





 



                     = map { ($_->get_attribute( 'match_view_arg' )->get_self_id() => $_) } 




1396




 





 





 





 





 





 



                       @{$view_src_node->get_child_nodes( 'view_src_arg' )}; 




1397




 





 





 





 





 





 



                 # Note: The build_expr() calls are done below to ensure the arg values are 




1398




 





 





 





 





 





 



                 # defined in the same order they are output; this lets optional insertion 




1399




 





 





 





 





 





 



                 # of positionally determined host params (and their mapping) to work right. 




1400




 





 





 





 





 





 



                 my $arg_list = join q{, }, 




1401




 





 





 





 





 





 



                     map { ($_ ? $builder->build_expr( $_ ) : 'NULL') } 




1402




 





 





 





 





 





 



                     map { $src_args_to_view_exprs{$view_args_to_src_args{$_->get_self_id()}->get_self_id()} } 




1403




 





 





 





 





 





 



                     @{$match_node->get_child_nodes( 'view_arg' )}; 




1404




 





 





 





 





 





 



                 return $match_name 




1405




 





 





 





 





 





 



                        . ($arg_list ? '(' . $arg_list . ')' : $EMPTY_STR) 




1406




 





 





 





 





 





 



                        . ' AS ' . $correlation_name; 




1407




 





 





 





 





 





 



             } 




1408




 





 





 





 





 





 



         } 




1409




 





 





 





 





 





 



         else { 




1410




 





 





 





 





 





 



             # The view we are matching is a schema object. 




1411




 





 





 





 





 





 



             return $match_name . ' AS ' . $correlation_name; 




1412




 





 





 





 





 





 



         } 




1413




 





 





 





 





 





 



     } 




1414




 





 





 





 





 





 



     else { # the source node is a base table schema object or a local variable of some kind 




1415




 





 





 





 





 





 



         return $match_name . ' AS ' . $correlation_name; 




1416




 





 





 





 





 





 



     } 




1417




 





 





 





 





 





 



 } 




1418




 





 





 





 





 





 



   




1419




 





 





 





 





 





 



 ###################################################################### 




1420




 





 





 





 





 





 



   




1421




 





 





 





 





 





 



 sub build_query_where_clause { # SQL:2003, 7.8 "" (p319) 




1422




 





 





 





 





 





 



     # Function returns empty string if view has no where clause. 




1423




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1424




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_where_clause', 




1425




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1426




 





 





 





 





 





 



     my @expr_list 




1427




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1428




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'WHERE' } 




1429




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1430




 





 





 





 





 





 



     return @expr_list ? "\n" . 'WHERE ' . $expr_list[0] : $EMPTY_STR; 




1431




 





 





 





 





 





 



 } 




1432




 





 





 





 





 





 



   




1433




 





 





 





 





 





 



 ###################################################################### 




1434




 





 





 





 





 





 



   




1435




 





 





 





 





 





 



 sub build_query_group_clause { # SQL:2003, 7.9 "" (p320) 




1436




 





 





 





 





 





 



     # Function returns empty string if view has no group by clause. 




1437




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1438




 





 





 





 





 





 



     my @expr_list 




1439




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1440




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'GROUP' } 




1441




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1442




 





 





 





 





 





 



     return @expr_list ? "\n" . 'GROUP BY ' . (join q{, }, @expr_list) : $EMPTY_STR; 




1443




 





 





 





 





 





 



     # Notes: Within build_expr(): 




1444




 





 





 





 





 





 



     #  implemented by COL basic_expr_type, 




1445




 





 





 





 





 





 



     #  and  implemented by LIST basic_expr_type, 




1446




 





 





 





 





 





 



     #  impl by ROSMN named GB_SETS, 




1447




 





 





 





 





 





 



     #  impl by ROSMN named GB_RLUP, 




1448




 





 





 





 





 





 



     #  impl by ROSMN named GB_CUBE. 




1449




 





 





 





 





 





 



     # Note:  has opt , looks redundant w SEL DIST|ALL; not impl. 




1450




 





 





 





 





 





 



 } 




1451




 





 





 





 





 





 



   




1452




 





 





 





 





 





 



 ###################################################################### 




1453




 





 





 





 





 





 



   




1454




 





 





 





 





 





 



 sub build_query_having_clause { # SQL:2003, 7.10 "" (p329) 




1455




 





 





 





 





 





 



     # Function returns empty string if view has no having clause. 




1456




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1457




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_having_clause', 




1458




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1459




 





 





 





 





 





 



     my @expr_list 




1460




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1461




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'HAVING' } 




1462




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1463




 





 





 





 





 





 



     return @expr_list ? "\n" . 'HAVING ' . $expr_list[0] : $EMPTY_STR; 




1464




 





 





 





 





 





 



 } 




1465




 





 





 





 





 





 



   




1466




 





 





 





 





 





 



 ###################################################################### 




1467




 





 





 





 





 





 



   




1468




 





 





 





 





 





 



 sub build_query_window_clause { # SQL:2003, 7.11 "" (p331) 




1469




 





 





 





 





 





 



     # Function returns empty string if view has no window clause. 




1470




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1471




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_window_clause', 




1472




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1473




 





 





 





 





 





 



     # TODO: I need to first update Rosetta::Model a bit re the various 




1474




 





 





 





 





 





 



     # parts of a , then fix here.  Meanwhile, I dump what I got. 




1475




 





 





 





 





 





 



     # Also see SQL:2003, 10.10 "" (p517) for future reference. 




1476




 





 





 





 





 





 



     my @order_list 




1477




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1478




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'ORDER' } 




1479




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1480




 





 





 





 





 





 



     my @maxr_list 




1481




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1482




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'MAXR' } 




1483




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1484




 





 





 





 





 





 



     my @skipr_list 




1485




 





 





 





 





 





 



         = map { $builder->build_expr( $_ ) } 




1486




 





 





 





 





 





 



           grep { $_->get_attribute( 'view_part' ) eq 'SKIPR' } 




1487




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




1488




 





 





 





 





 





 



     return (@order_list ? "\n" . 'ORDER BY ' . (join q{, }, @order_list) : $EMPTY_STR) 




1489




 





 





 





 





 





 



            . (@maxr_list ? "\n" . 'LIMIT ' . $maxr_list[0] : $EMPTY_STR) 




1490




 





 





 





 





 





 



            . (@skipr_list ? "\n" . 'OFFSET ' . $skipr_list[0] : $EMPTY_STR); 




1491




 





 





 





 





 





 



 } 




1492




 





 





 





 





 





 



   




1493




 





 





 





 





 





 



 ###################################################################### 




1494




 





 





 





 





 





 



   




1495




 





 





 





 





 





 



 sub build_query_query_spec { 




1496




 





 





 





 





 





 



     # SQL:2003, 7.12 "" (p341) 




1497




 





 





 





 





 





 



     # SQL:2003, 14.5 "" (p824) 




1498




 





 





 





 





 





 



     my ($builder, $view_node, $into_dest_node) = @_; 




1499




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_query_spec', 




1500




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1501




 





 





 





 





 





 



     defined $into_dest_node and $builder->_assert_arg_node_type( 'build_query_query_spec', 




1502




 





 





 





 





 





 



         'INTO_DEST_NODE', ['routine_arg','routine_var'], $into_dest_node ); 




1503




 





 





 





 





 





 



     # Method assumes that $view_node.view_type ne 'COMPOUND'; 




1504




 





 





 





 





 





 



     # method should never be invoked for those kinds of views. 




1505




 





 





 





 





 





 



     my $set_quantifier = $view_node->get_attribute( 'distinct_rows' ) ? 'DISTINCT' : 'ALL'; 




1506




 





 





 





 





 





 



     my $select_list = $builder->build_query_select_list( $view_node ); 




1507




 





 





 





 





 





 



     my $into_clause = $into_dest_node ? "\n" . 'INTO ' . $builder->build_identifier_element( $into_dest_node ) : $EMPTY_STR; 




1508




 





 





 





 





 





 



     my $table_expression = $builder->build_query_table_expr( $view_node ); 




1509




 





 





 





 





 





 



     return "\n" . 'SELECT ' . $set_quantifier . ' ' . $select_list . $into_clause . $table_expression; 




1510




 





 





 





 





 





 



 } 




1511




 





 





 





 





 





 



   




1512




 





 





 





 





 





 



 ###################################################################### 




1513




 





 





 





 





 





 



   




1514




 





 





 





 





 





 



 sub build_query_select_list { # SQL:2003, 7.12 "" (p341) 




1515




 





 





 





 





 





 



     # Method returns comma-delimited list expression where each list item is a 




1516




 





 





 





 





 





 



     # " ::=  AS ". 




1517




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1518




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_select_list', 




1519




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1520




 





 





 





 





 





 



     if ($view_node->get_attribute( 'view_type' ) eq 'ALIAS') { 




1521




 





 





 





 





 





 



         # Each result column must match a source column exactly. 




1522




 





 





 





 





 





 



         # Every source table/view result column or var field is output, with the same name. 




1523




 





 





 





 





 





 



         # It is assumed/required that the view has the same 'row_data_type' as the source. 




1524




 





 





 





 





 





 



         # While '*' would conceptually work here, we still explicitly enumerate col name list 




1525




 





 





 





 





 





 



         # so compound selects and select-intos don't break when original create tbl/vw statement 




1526




 





 





 





 





 





 



         # had declared columns in a different order than our row-data-type does. 




1527




 





 





 





 





 





 



         my $row_data_type_node = $builder->_row_data_type_of_node( $view_node ); 




1528




 





 





 





 





 





 



         return join q{, } . "\n", 




1529




 





 





 





 





 





 



             map { $builder->build_identifier_element( $_ ) } 




1530




 





 





 





 





 





 



             @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}; 




1531




 





 





 





 





 





 



     } 




1532




 





 





 





 





 





 



     else { # view_type ne 'ALIAS' 




1533




 





 





 





 





 





 



         # Each result column may come from an arbitrarily complex expression. 




1534




 





 





 





 





 





 



         # We have three statements below instead of one because we want the result cols shown 




1535




 





 





 





 





 





 



         # in order of the view's "row_data_type_field" Nodes, not the order of the 'view_part' if different. 




1536




 





 





 





 





 





 



         my %select_list_view_fields 




1537




 





 





 





 





 





 



             = map { ($_->get_attribute( 'si_row_field' )->get_self_id() => $_->get_attribute( 'src_field' )) } 




1538




 





 





 





 





 





 



               @{$view_node->get_child_nodes( 'view_field' )}; # note: 'src_field' may be undefined 




1539




 





 





 





 





 





 



         my %select_list_view_exprs 




1540




 





 





 





 





 





 



             = map { ($_->get_attribute( 'set_result_field' )->get_self_id() => $_) } 




1541




 





 





 





 





 





 



               grep { $_->get_attribute( 'view_part' ) eq 'RESULT' } 




1542




 





 





 





 





 





 



               @{$view_node->get_child_nodes( 'view_expr' )}; 




1543




 





 





 





 





 





 



         # Note: The build_expr() calls are done below to ensure the arg values are 




1544




 





 





 





 





 





 



         # defined in the same order they are output; this lets optional insertion 




1545




 





 





 





 





 





 



         # of positionally determined host params (and their mapping) to work right. 




1546




 





 





 





 





 





 



         my $row_data_type_node = $builder->_row_data_type_of_node( $view_node ); 




1547




 





 





 





 





 





 



         return join q{, } . "\n", 




1548




 





 





 





 





 





 



             map { ($select_list_view_fields{$_->get_self_id()} 




1549




 





 





 





 





 





 



                    ? $builder->build_identifier_view_src_field( $select_list_view_fields{$_->get_self_id()} ) 




1550




 





 





 





 





 





 



                    : $select_list_view_exprs{$_->get_self_id()} 




1551




 





 





 





 





 





 



                    ? $builder->build_expr( $select_list_view_exprs{$_->get_self_id()} ) 




1552




 





 





 





 





 





 



                    : 'NULL') 




1553




 





 





 





 





 





 



                 . ' AS ' . $builder->build_identifier_element( $_ ) } 




1554




 





 





 





 





 





 



             @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}; 




1555




 





 





 





 





 





 



         # Note that the default of NULL thing deals with view's row field that don't have any view_expr or src_field. 




1556




 





 





 





 





 





 



         # TODO IF NOT WRONG/OUTDATED: Note that the 'view_field' Nodes we actually need may be in a parent view 




1557




 





 





 





 





 





 



         # of the current view; right now we only are looking in the current view. 




1558




 





 





 





 





 





 



     } 




1559




 





 





 





 





 





 



 } 




1560




 





 





 





 





 





 



   




1561




 





 





 





 





 





 



 ###################################################################### 




1562




 





 





 





 





 





 



   




1563




 





 





 





 





 





 



 sub build_query_query_expr { # SQL:2003, 7.13 "" (p351) 




1564




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1565




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_query_expr', 




1566




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1567




 





 





 





 





 





 



     my $view_type = $view_node->get_attribute( 'view_type' ); 




1568




 





 





 





 





 





 



     my $with_clause = $EMPTY_STR; 




1569




 





 





 





 





 





 



     if (!$builder->{$PROP_INLINE_SUBQ}) { 




1570




 





 





 





 





 





 



         my @with_list = (); 




1571




 





 





 





 





 





 



         my $recursive = 0; 




1572




 





 





 





 





 





 



         for my $child_view_node (@{$view_node->get_child_nodes( 'view' )}) { 




1573




 





 





 





 





 





 



             if ($child_view_node->get_attribute( 'recursive' )) { 




1574




 





 





 





 





 





 



                 $recursive = 1; 




1575




 





 





 





 





 





 



             } 




1576




 





 





 





 





 





 



             my $with_item = $builder->build_identifier_element( $child_view_node ); 




1577




 





 





 





 





 





 



             if (my @child_arg_nodes = @{$child_view_node->get_child_nodes( 'view_arg' )}) { 




1578




 





 





 





 





 





 



                 $with_item .= '(' . (join q{, }, 




1579




 





 





 





 





 





 



                     map { $builder->build_identifier_element( $_ ) } 




1580




 





 





 





 





 





 



                     @child_arg_nodes) . ')'; 




1581




 





 





 





 





 





 



             } 




1582




 





 





 





 





 





 



             $with_item .= ' AS (' . $builder->build_query_query_expr( $child_view_node ) . ')'; 




1583




 





 





 





 





 





 



             push @with_list, $with_item; 




1584




 





 





 





 





 





 



         } 




1585




 





 





 





 





 





 



         if (@with_list) { 




1586




 





 





 





 





 





 



             $with_clause = "\n" . 'WITH ' . ($recursive ? 'RECURSIVE ' : $EMPTY_STR) . (join q{, }, @with_list); 




1587




 





 





 





 





 





 



         } 




1588




 





 





 





 





 





 



     } 




1589




 





 





 





 





 





 



     my $query_expression_body = $builder->build_query_query_expr_body( $view_node ); 




1590




 





 





 





 





 





 



     return $with_clause . $query_expression_body; 




1591




 





 





 





 





 





 



     # TODO: SQL:2003, 7.14 "" (p365). 




1592




 





 





 





 





 





 



 } 




1593




 





 





 





 





 





 



   




1594




 





 





 





 





 





 



 ###################################################################### 




1595




 





 





 





 





 





 



   




1596




 





 





 





 





 





 



 sub build_query_query_expr_body { # SQL:2003, 7.13 "" (p351) 




1597




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1598




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_query_expr_body', 




1599




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1600




 





 





 





 





 





 



     if ($view_node->get_attribute( 'view_type' ) eq 'COMPOUND') { 




1601




 





 





 





 





 





 



         # Result is multiple "SELECT ..." connected by one or more compound operators. 




1602




 





 





 





 





 





 



         my $compound_op = $view_node->get_attribute( 'compound_op' ); 




1603




 





 





 





 





 





 



         my $set_quantifier = $view_node->get_attribute( 'distinct_rows' ) ? 'DISTINCT' : 'ALL'; 




1604




 





 





 





 





 





 



         my @operand_list = (); 




1605




 





 





 





 





 





 



         for my $elem_node (@{$view_node->get_child_nodes( 'view_compound_elem' )}) { 




1606




 





 





 





 





 





 



             my $view_src_node = $elem_node->get_attribute( 'operand' ); 




1607




 





 





 





 





 





 



             my $match_node = $view_src_node->get_attribute( 'match' ); 




1608




 





 





 





 





 





 



             my $match_name = $builder->build_identifier_schema_or_app_obj( $match_node ); 




1609




 





 





 





 





 





 



             # Each compounding operand is assumed to have the same row data type as the view. 




1610




 





 





 





 





 





 



             if ($match_node->get_node_type() eq 'table') { 




1611




 





 





 





 





 





 



                 my $row_data_type_node = $builder->_row_data_type_of_node( $match_node ); 




1612




 





 





 





 





 





 



                 push @operand_list, join q{, } . "\n", 




1613




 





 





 





 





 





 



                     map { $builder->build_identifier_element( $_ ) } 




1614




 





 





 





 





 





 



                     @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}; 




1615




 





 





 





 





 





 



             } 




1616




 





 





 





 





 





 



             elsif ($match_node->get_node_type() eq 'view') { 




1617




 





 





 





 





 





 



                 push @operand_list, $builder->build_query_query_expr( $match_node ); 




1618




 





 





 





 





 





 



             } 




1619




 





 





 





 





 





 



             else { # the source node is a local variable of some kind 




1620




 





 





 





 





 





 



                 push @operand_list, $match_name; 




1621




 





 





 





 





 





 



             } 




1622




 





 





 





 





 





 



         } 




1623




 





 





 





 





 





 



         my $sql_operator 




1624




 





 





 





 





 





 



             = $compound_op eq 'UNION'        ? 'UNION' 




1625




 





 





 





 





 





 



             : $compound_op eq 'DIFFERENCE'   ? 'EXCEPT' 




1626




 





 





 





 





 





 



             : $compound_op eq 'INTERSECTION' ? 'INTERSECT' 




1627




 





 





 





 





 





 



             : $compound_op eq 'EXCLUSION'    ? 'EXCLUSION' # this 4th option not in SQL:2003. 




1628




 





 





 





 





 





 



             :                                  undef # we should never get here 




1629




 





 





 





 





 





 



             ; 




1630




 





 





 





 





 





 



             # TODO: try to emulate 'EXCLUSION' somewhere. 




1631




 





 





 





 





 





 



         return '(' . (join "\n" . $sql_operator . '_' . $set_quantifier, @operand_list) . ')'; 




1632




 





 





 





 





 





 



         # TODO: deal with engines that don't like "()" bounding compound operations. 




1633




 





 





 





 





 





 



         # TODO: possibly implement . 




1634




 





 





 





 





 





 



     } 




1635




 





 





 





 





 





 



     else { # view type ne 'COMPOUND' 




1636




 





 





 





 





 





 



         # Result is a single "SELECT ...", also known as a single "". 




1637




 





 





 





 





 





 



         return $builder->build_query_query_spec( $view_node ); 




1638




 





 





 





 





 





 



     } 




1639




 





 





 





 





 





 



 } 




1640




 





 





 





 





 





 



   




1641




 





 





 





 





 





 



 ###################################################################### 




1642




 





 





 





 





 





 



   




1643




 





 





 





 





 





 



 sub build_query_subquery { # SQL:2003, 7.15 "" (p370) 




1644




 





 





 





 





 





 



     my ($builder, $expr_node) = @_; 




1645




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_query_subquery', 




1646




 





 





 





 





 





 



         'EXPR_NODE', ['view_expr'], $expr_node ); 




1647




 





 





 





 





 





 



     my $cview = $expr_node->get_attribute( 'valf_call_view' ); 




1648




 





 





 





 





 





 



     if ($builder->{$PROP_INLINE_SUBQ}) { 




1649




 





 





 





 





 





 



         # Embed an anonymous subquery; argument passing is not yet supported. 




1650




 





 





 





 





 





 



         my $query_expression = $builder->build_query_query_expr( $cview ); 




1651




 





 





 





 





 





 



         return '(' . $query_expression . ')'; 




1652




 





 





 





 





 





 



     } 




1653




 





 





 





 





 





 



     else { 




1654




 





 





 





 





 





 



         # Call a named subquery; argument passing is supported. 




1655




 





 





 





 





 





 



         my $cview_name = $builder->build_identifier_schema_or_app_obj( $cview ); 




1656




 





 





 





 





 





 



         my %cview_arg_exprs 




1657




 





 





 





 





 





 



             = map { ($_->get_attribute( 'call_view_arg' )->get_self_id() => $_) } 




1658




 





 





 





 





 





 



               @{$expr_node->get_child_nodes()}; # gets child view_expr Nodes 




1659




 





 





 





 





 





 



         # Note: The build_expr() calls are done below to ensure the arg values are 




1660




 





 





 





 





 





 



         # defined in the same order they are output; this lets optional insertion 




1661




 





 





 





 





 





 



         # of positionally determined host params (and their mapping) to work right. 




1662




 





 





 





 





 





 



         my $arg_val_list = join q{, }, 




1663




 





 





 





 





 





 



             map { $cview_arg_exprs{$_->get_self_id()} 




1664




 





 





 





 





 





 



                   ? $builder->build_expr( $cview_arg_exprs{$_->get_self_id()} ) 




1665




 





 





 





 





 





 



                   : 'NULL' } 




1666




 





 





 





 





 





 



             @{$cview->get_child_nodes( 'view_arg' )}; 




1667




 





 





 





 





 





 



         return $cview_name . ($arg_val_list ? '(' . $arg_val_list . ')' : $EMPTY_STR); 




1668




 





 





 





 





 





 



     } 




1669




 





 





 





 





 





 



     # Note: Direct calls to schema object tables or views is not supported outside of 'FROM'. 




1670




 





 





 





 





 





 



 } 




1671




 





 





 





 





 





 



   




1672




 





 





 





 





 





 



 ###################################################################### 




1673




 





 





 





 





 





 



   




1674




 





 





 





 





 





 



 sub build_schema_create { # SQL:2003, 11.1 "" (p519) 




1675




 





 





 





 





 





 



     my ($builder, $schema_node) = @_; 




1676




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_create', 




1677




 





 





 





 





 





 



         'SCHEMA_NODE', ['schema'], $schema_node ); 




1678




 





 





 





 





 





 



     my $schema_name = $builder->build_identifier_element( $schema_node ); 




1679




 





 





 





 





 





 



     my $authorization = $EMPTY_STR; # TODO: AUTHORIZATION  




1680




 





 





 





 





 





 



     # Some other features in 11.1, such as default character set. 




1681




 





 





 





 





 





 



     return 'CREATE SCHEMA ' . $schema_name . ' ' . $authorization . ';' . "\n"; 




1682




 





 





 





 





 





 



 } 




1683




 





 





 





 





 





 



   




1684




 





 





 





 





 





 



 sub build_schema_delete { # SQL:2003, 11.2 "" (p522) 




1685




 





 





 





 





 





 



     my ($builder, $schema_node) = @_; 




1686




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_delete', 




1687




 





 





 





 





 





 



         'SCHEMA_NODE', ['schema'], $schema_node ); 




1688




 





 





 





 





 





 



     my $schema_name = $builder->build_identifier_element( $schema_node ); 




1689




 





 





 





 





 





 



     return 'DROP SCHEMA ' . $schema_name . ';' . "\n"; 




1690




 





 





 





 





 





 



 } 




1691




 





 





 





 





 





 



   




1692




 





 





 





 





 





 



 ###################################################################### 




1693




 





 





 





 





 





 



   




1694




 





 





 





 





 





 



 sub build_schema_or_app_scalar_domain_create { # SQL:2003, 11.24 "" (p603) 




1695




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1696




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_scalar_domain_create', 




1697




 





 





 





 





 





 



         'DOMAIN_NODE', ['scalar_domain'], $domain_node ); 




1698




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1699




 





 





 





 





 





 



     my $predefined_type = $builder->build_expr_scalar_data_type_defn( $domain_node ); 




1700




 





 





 





 





 





 



     # TODO: default clause, domain constraint, collate clause. 




1701




 





 





 





 





 





 



     my $is_temp = ($domain_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1702




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' DOMAIN ' . $domain_name . ' AS ' . $predefined_type . ';' . "\n"; 




1703




 





 





 





 





 





 



 } 




1704




 





 





 





 





 





 



   




1705




 





 





 





 





 





 



 sub build_schema_or_app_scalar_domain_delete { # SQL:2003, 11.30 "" (p610) 




1706




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1707




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_scalar_domain_delete', 




1708




 





 





 





 





 





 



         'DOMAIN_NODE', ['scalar_domain'], $domain_node ); 




1709




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1710




 





 





 





 





 





 



     return 'DROP DOMAIN ' . $domain_name . ';' . "\n"; 




1711




 





 





 





 





 





 



 } 




1712




 





 





 





 





 





 



   




1713




 





 





 





 





 





 



 ###################################################################### 




1714




 





 





 





 





 





 



   




1715




 





 





 





 





 





 



 sub build_schema_or_app_row_domain_create { # SQL:2003, 11.24 "" (p603) 




1716




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1717




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_row_domain_create', 




1718




 





 





 





 





 





 



         'DOMAIN_NODE', ['row_domain'], $domain_node ); 




1719




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1720




 





 





 





 





 





 



     my $predefined_type = $builder->build_expr_row_data_type_defn( $domain_node ); 




1721




 





 





 





 





 





 



     # TODO: default clause, domain constraint, collate clause. 




1722




 





 





 





 





 





 



     my $is_temp = ($domain_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1723




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' DOMAIN ' . $domain_name . ' AS ' . $predefined_type . ';' . "\n"; 




1724




 





 





 





 





 





 



 } 




1725




 





 





 





 





 





 



   




1726




 





 





 





 





 





 



 sub build_schema_or_app_row_domain_delete { # SQL:2003, 11.30 "" (p610) 




1727




 





 





 





 





 





 



     my ($builder, $domain_node) = @_; 




1728




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_row_domain_delete', 




1729




 





 





 





 





 





 



         'DOMAIN_NODE', ['row_domain'], $domain_node ); 




1730




 





 





 





 





 





 



     my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 ); 




1731




 





 





 





 





 





 



     return 'DROP DOMAIN ' . $domain_name . ';' . "\n"; 




1732




 





 





 





 





 





 



 } 




1733




 





 





 





 





 





 



   




1734




 





 





 





 





 





 



 ###################################################################### 




1735




 





 





 





 





 





 



   




1736




 





 





 





 





 





 



 sub build_schema_or_app_sequence_create { # SQL:2003, 11.62 "" (p726) 




1737




 





 





 





 





 





 



     my ($builder, $sequence_node) = @_; 




1738




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_sequence_create', 




1739




 





 





 





 





 





 



         'SEQUENCE_NODE', ['sequence'], $sequence_node ); 




1740




 





 





 





 





 





 



     # SQL:2003 allows multiple data types for this, but we stick to integers for now. 




1741




 





 





 





 





 





 



     my $sequence_name = $builder->build_identifier_schema_or_app_obj( $sequence_node, 1 ); 




1742




 





 





 





 





 





 



     my $increment = $sequence_node->get_attribute( 'increment' ); 




1743




 





 





 





 





 





 



     my $min_val = $sequence_node->get_attribute( 'min_val' ); 




1744




 





 





 





 





 





 



     my $max_val = $sequence_node->get_attribute( 'max_val' ); 




1745




 





 





 





 





 





 



     my $start_val = $sequence_node->get_attribute( 'start_val' ); 




1746




 





 





 





 





 





 



     my $cycle = $sequence_node->get_attribute( 'cycle' ); 




1747




 





 





 





 





 





 



     my $order = $sequence_node->get_attribute( 'order' ); 




1748




 





 





 





 





 





 



     # Note that Rosetta::Model guarantees all integer attributes are already valid integers. 




1749




 





 





 





 





 





 



     my $is_temp = ($sequence_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1750




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' SEQUENCE ' . $sequence_name 




1751




 





 





 





 





 





 



         . (defined $increment ? ' INCREMENT BY ' . $increment : $EMPTY_STR) 




1752




 





 





 





 





 





 



         . (defined $start_val ? ' START WITH ' . $start_val : $EMPTY_STR) 




1753




 





 





 





 





 





 



         . (defined $min_val ? ' MINVALUE ' . $min_val : ' NO MINVALUE') 




1754




 





 





 





 





 





 



         . (defined $max_val ? ' MAXVALUE ' . $max_val : ' NO MAXVALUE') 




1755




 





 





 





 





 





 



         . ($cycle ? ' CYCLE' : ' NO CYCLE') 




1756




 





 





 





 





 





 



         . ($order ? ' ORDER' : ' NO ORDER') # standard doesn't mention this one 




1757




 





 





 





 





 





 



         . ';' . "\n"; 




1758




 





 





 





 





 





 



 } 




1759




 





 





 





 





 





 



   




1760




 





 





 





 





 





 



 sub build_schema_or_app_sequence_delete { # SQL:2003, 11.64 "" (p729) 




1761




 





 





 





 





 





 



     my ($builder, $sequence_node) = @_; 




1762




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_sequence_delete', 




1763




 





 





 





 





 





 



         'SEQUENCE_NODE', ['sequence'], $sequence_node ); 




1764




 





 





 





 





 





 



     my $sequence_name = $builder->build_identifier_schema_or_app_obj( $sequence_node, 1 ); 




1765




 





 





 





 





 





 



     return 'DROP SEQUENCE ' . $sequence_name . ';' . "\n"; 




1766




 





 





 





 





 





 



 } 




1767




 





 





 





 





 





 



   




1768




 





 





 





 





 





 



 ###################################################################### 




1769




 





 





 





 





 





 



   




1770




 





 





 





 





 





 



 sub build_schema_or_app_table_create { 




1771




 





 





 





 





 





 



     # SQL:2003, 6.2 "" (p173) 




1772




 





 





 





 





 





 



     # SQL:2003, 11.3 "" (p525) 




1773




 





 





 





 





 





 



     # SQL:2003, 11.4 "" (p536) 




1774




 





 





 





 





 





 



     # SQL:2003, 11.5 "" (p541) 




1775




 





 





 





 





 





 



     # SQL:2003, 11.6 "" (p545) 




1776




 





 





 





 





 





 



     # SQL:2003, 11.7 "" (p547) 




1777




 





 





 





 





 





 



     # SQL:2003, 11.8 "" (p549) 




1778




 





 





 





 





 





 



     # TODO: SQL:2003, 11.9 "" (p569) 




1779




 





 





 





 





 





 



     # TODO: "GENERATED ALWAYS AS ..." which looks like FileMaker's (etc) "calculation" field types. 




1780




 





 





 





 





 





 



     my ($builder, $table_node) = @_; 




1781




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_table_create', 




1782




 





 





 





 





 





 



         'TABLE_NODE', ['table'], $table_node ); 




1783




 





 





 





 





 





 



     my $table_name = $builder->build_identifier_schema_or_app_obj( $table_node, 1 ); 




1784




 





 





 





 





 





 



     my @table_field_sql = (); 




1785




 





 





 





 





 





 



     my %col_name_cache = (); # used when making ind defs 




1786




 





 





 





 





 





 



     my %mandatory_field_cache = (); # used when making ind defs 




1787




 





 





 





 





 





 



     my %table_fields_by_row_field = map { ($_->get_attribute( 'si_row_field' )->get_self_id() => $_) } 




1788




 





 





 





 





 





 



         @{$table_node->get_child_nodes( 'table_field' )}; 




1789




 





 





 





 





 





 



     my $row_data_type_node = $builder->_row_data_type_of_node( $table_node ); # is always set 




1790




 





 





 





 





 





 



     my $row_domain_node = $builder->_row_domain_of_node( $table_node ); # may be undefined 




1791




 





 





 





 





 





 



     for my $row_field_node (@{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}) { 




1792




 





 





 





 





 





 



         my $table_field_name = $builder->build_identifier_element( $row_field_node ); 




1793




 





 





 





 





 





 



         if (!exists $col_name_cache{$row_field_node->get_self_id()}) { 




1794




 





 





 





 





 





 



             $col_name_cache{$row_field_node->get_self_id()} = $table_field_name; 




1795




 





 





 





 





 





 



         } 




1796




 





 





 





 





 





 



         my $scalar_data_type_node = $row_field_node->get_attribute( 'scalar_data_type' ); 




1797




 





 





 





 





 





 



         my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( 




1798




 





 





 





 





 





 



             $row_domain_node ? $builder->find_scalar_domain_for_row_domain_field( 




1799




 





 





 





 





 





 



             $scalar_data_type_node, $row_domain_node ) : $scalar_data_type_node ); 




1800




 





 





 





 





 





 



         my $table_field_sql_item = $table_field_name . ' ' . $dt_or_dom_sql; 




1801




 





 





 





 





 





 



         if (my $table_field_node = $table_fields_by_row_field{$row_field_node->get_self_id()}) { 




1802




 





 





 





 





 





 



             my $mandatory = $table_field_node->get_attribute( 'mandatory' ); 




1803




 





 





 





 





 





 



             $mandatory and $mandatory_field_cache{$row_field_node->get_self_id()} = 1; 




1804




 





 





 





 





 





 



             my $default_val = $table_field_node->get_attribute( 'default_val' ); 




1805




 





 





 





 





 





 



             my $auto_inc = $table_field_node->get_attribute( 'auto_inc' ); 




1806




 





 





 





 





 





 



             my $default_seq_node = $table_field_node->get_attribute( 'default_seq' ); 




1807




 





 





 





 





 





 



             $table_field_sql_item .= ($mandatory ? ' NOT NULL' : ' NULL') 




1808




 





 





 





 





 





 



                 . (defined $default_val ? ' DEFAULT ' . $builder->quote_literal( 




1809




 





 





 





 





 





 



                     $default_val, $scalar_data_type_node->get_attribute( 'base_type' ) ) : $EMPTY_STR) 




1810




 





 





 





 





 





 



                 . ($auto_inc ? ' AUTO_INCREMENT' : $EMPTY_STR) 




1811




 





 





 





 





 





 



                 . ($default_seq_node ? ' DEFAULT ' 




1812




 





 





 





 





 





 



                     . $builder->build_expr_seq_next( $default_seq_node ) : $EMPTY_STR); 




1813




 





 





 





 





 





 



         } 




1814




 





 





 





 





 





 



         else { 




1815




 





 





 





 





 





 



             $table_field_sql_item .= ' NULL'; 




1816




 





 





 





 





 





 



         } 




1817




 





 





 





 





 





 



         push @table_field_sql, $table_field_sql_item; 




1818




 





 





 





 





 





 



     } 




1819




 





 





 





 





 





 



     my @table_index_sql = (); 




1820




 





 





 





 





 





 



     my $pk_is_made = 0; 




1821




 





 





 





 





 





 



     for my $table_index_node (@{$table_node->get_child_nodes( 'table_index' )}) { 




1822




 





 





 





 





 





 



         my $table_index_name = $builder->build_identifier_element( $table_index_node ); 




1823




 





 





 





 





 





 



         my $index_type = $table_index_node->get_attribute( 'index_type' ); 




1824




 





 





 





 





 





 



         my @table_index_field_nodes = @{$table_index_node->get_child_nodes( 'table_index_field' )}; 




1825




 





 





 





 





 





 



         my $local_field_names_sql = join q{, }, map { 




1826




 





 





 





 





 





 



                 $col_name_cache{$_->get_attribute( 'si_field' )->get_self_id()} 




1827




 





 





 





 





 





 



             } @table_index_field_nodes; 




1828




 





 





 





 





 





 



         if ($index_type eq 'ATOMIC') { 




1829




 





 





 





 





 





 



             push @table_index_sql, 'INDEX ' . $table_index_name . ' (' . $local_field_names_sql . ')'; 




1830




 





 





 





 





 





 



         } 




1831




 





 





 





 





 





 



         if ($index_type eq 'FULLTEXT') { 




1832




 





 





 





 





 





 



             push @table_index_sql, 'FULLTEXT INDEX ' . $table_index_name . ' (' . $local_field_names_sql . ')'; 




1833




 





 





 





 





 





 



         } 




1834




 





 





 





 





 





 



         if ($index_type eq 'UNIQUE' or $index_type eq 'UFOREIGN') { 




1835




 





 





 





 





 





 



             my $make_a_pk_now = 0; 




1836




 





 





 





 





 





 



             if (!$pk_is_made) { 




1837




 





 





 





 





 





 



                 # All component columns of a primary key must be mandatory; check for it. 




1838




 





 





 





 





 





 



                 $make_a_pk_now = all { 




1839




 





 





 





 





 





 



                         $mandatory_field_cache{ $_->get_attribute( 'si_field' )->get_self_id() } 




1840




 





 





 





 





 





 



                     } @table_index_field_nodes; 




1841




 





 





 





 





 





 



             } 




1842




 





 





 





 





 





 



             if ($make_a_pk_now) { 




1843




 





 





 





 





 





 



                 push @table_index_sql, 'CONSTRAINT PRIMARY KEY (' . $local_field_names_sql . ')'; 




1844




 





 





 





 





 





 



             } 




1845




 





 





 





 





 





 



             else { 




1846




 





 





 





 





 





 



                 push @table_index_sql, 'CONSTRAINT ' . $table_index_name . ' UNIQUE' 




1847




 





 





 





 





 





 



                     . ' (' . $local_field_names_sql . ')'; # standard does not say INDEX after UNIQUE 




1848




 





 





 





 





 





 



             } 




1849




 





 





 





 





 





 



         } 




1850




 





 





 





 





 





 



         if ($index_type eq 'FOREIGN' or $index_type eq 'UFOREIGN') { 




1851




 





 





 





 





 





 



             my $foreign_table_name = $builder->build_identifier_schema_or_app_obj( 




1852




 





 





 





 





 





 



                 $table_index_node->get_attribute( 'f_table' ) ); 




1853




 





 





 





 





 





 



             my $foreign_field_names_sql = join q{, }, map { 




1854




 





 





 





 





 





 



                     $builder->build_identifier_element( $_->get_attribute( 'f_field' ) ) 




1855




 





 





 





 





 





 



                 } @table_index_field_nodes; 




1856




 





 





 





 





 





 



             push @table_index_sql, 'CONSTRAINT ' . $table_index_name . ' FOREIGN KEY' 




1857




 





 





 





 





 





 



                 . ' (' . $local_field_names_sql . ') REFERENCES ' . $foreign_table_name 




1858




 





 





 





 





 





 



                 . ' (' . $foreign_field_names_sql . ')'; 




1859




 





 





 





 





 





 



         } 




1860




 





 





 





 





 





 



     } 




1861




 





 





 





 





 





 



     my $is_temp = ($table_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1862




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' TABLE ' . $table_name 




1863




 





 





 





 





 





 



            . ' (' . "\n" . (join q{, } . "\n", @table_field_sql, @table_index_sql) . "\n" . ');' . "\n"; 




1864




 





 





 





 





 





 



 } 




1865




 





 





 





 





 





 



   




1866




 





 





 





 





 





 



 sub build_schema_or_app_table_delete { # SQL:2003, 11.21 "" (p587) 




1867




 





 





 





 





 





 



     my ($builder, $table_node) = @_; 




1868




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_table_delete', 




1869




 





 





 





 





 





 



         'TABLE_NODE', ['table'], $table_node ); 




1870




 





 





 





 





 





 



     my $table_name = $builder->build_identifier_schema_or_app_obj( $table_node, 1 ); 




1871




 





 





 





 





 





 



     return 'DROP TABLE ' . $table_name . ';' . "\n"; 




1872




 





 





 





 





 





 



 } 




1873




 





 





 





 





 





 



   




1874




 





 





 





 





 





 



 ###################################################################### 




1875




 





 





 





 





 





 



   




1876




 





 





 





 





 





 



 sub build_schema_or_app_view_create { # SQL:2003, 11.22 "" (p590) 




1877




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1878




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_view_create', 




1879




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1880




 





 





 





 





 





 



     my $view_name = $builder->build_identifier_schema_or_app_obj( $view_node, 1 ); 




1881




 





 





 





 





 





 



     my $query_expression = $builder->build_query_query_expr( $view_node ); 




1882




 





 





 





 





 





 



     my $is_temp = ($view_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1883




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' VIEW ' . $view_name . ' AS ' . $query_expression . ';' . "\n"; 




1884




 





 





 





 





 





 



     # Note: Several interesting looking features are not implemented yet. 




1885




 





 





 





 





 





 



 } 




1886




 





 





 





 





 





 



   




1887




 





 





 





 





 





 



 sub build_schema_or_app_view_delete { # SQL:2003, 11.23 "" (p600) 




1888




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1889




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_view_delete', 




1890




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1891




 





 





 





 





 





 



     my $view_name = $builder->build_identifier_schema_or_app_obj( $view_node, 1 ); 




1892




 





 





 





 





 





 



     return 'DROP VIEW ' . $view_name . ';' . "\n"; 




1893




 





 





 





 





 





 



 } 




1894




 





 





 





 





 





 



   




1895




 





 





 





 





 





 



 ###################################################################### 




1896




 





 





 





 





 





 



   




1897




 





 





 





 





 





 



 sub build_schema_or_app_routine_create { 




1898




 





 





 





 





 





 



     # SQL:2003, 11.39 "" (p629) 




1899




 





 





 





 





 





 



     # SQL:2003, 11.50 "" (p675) 




1900




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




1901




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_routine_create', 




1902




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




1903




 





 





 





 





 





 



     my $routine_type = $routine_node->get_attribute( 'routine_type' ); 




1904




 





 





 





 





 





 



     my $routine_name = $builder->build_identifier_schema_or_app_obj( $routine_node, 1 ); 




1905




 





 





 





 





 





 



     my $is_temp = ($routine_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1906




 





 





 





 





 





 



     if ($routine_type eq 'PACKAGE') { 




1907




 





 





 





 





 





 



         # Not implemented yet. 




1908




 





 





 





 





 





 



     } 




1909




 





 





 





 





 





 



     elsif ($routine_type eq 'TRIGGER') { 




1910




 





 





 





 





 





 



         my $table_or_view_name = $builder->build_identifier_schema_or_app_obj( 




1911




 





 





 





 





 





 



             $routine_node->get_attribute( 'trigger_on' ) ); 




1912




 





 





 





 





 





 



         my $trigger_event = $routine_node->get_attribute( 'trigger_event' ); 




1913




 





 





 





 





 





 



         my $trigger_event_sql 




1914




 





 





 





 





 





 



             = $trigger_event eq 'BEFR_INS' ? 'BEFORE INSERT' 




1915




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_INS' ? 'AFTER INSERT' 




1916




 





 





 





 





 





 



             : $trigger_event eq 'INST_INS' ? 'INSTEAD OF INSERT' 




1917




 





 





 





 





 





 



             : $trigger_event eq 'BEFR_UPD' ? 'BEFORE UPDATE' 




1918




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_UPD' ? 'AFTER UPDATE' 




1919




 





 





 





 





 





 



             : $trigger_event eq 'INST_UPD' ? 'INSTEAD OF UPDATE' 




1920




 





 





 





 





 





 



             : $trigger_event eq 'BEFR_DEL' ? 'BEFORE DELETE' 




1921




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_DEL' ? 'AFTER DELETE' 




1922




 





 





 





 





 





 



             : $trigger_event eq 'INST_DEL' ? 'INSTEAD OF DELETE' 




1923




 





 





 





 





 





 



             :                                undef # we should never get here 




1924




 





 





 





 





 





 



             ; 




1925




 





 





 





 





 





 



             # Note: INSTEAD OF is not standard SQL, but supported by SQLServer 2000, maybe Oracle, ?. 




1926




 





 





 





 





 





 



         my $for_each_stmt = $routine_node->get_attribute( 'trigger_per_stmt' ); 




1927




 





 





 





 





 





 



         # TODO: Implement optional OF . 




1928




 





 





 





 





 





 



         my @transition_var_names = (); # TODO: NEW/OLD ROW AS <... variable name> 




1929




 





 





 





 





 





 



         my $triggered_sql_statement = $builder->build_dmanip_routine_body( $routine_node, 1 ); 




1930




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' TRIGGER ' . $routine_name . ' ' 




1931




 





 





 





 





 





 



             . $trigger_event_sql . ' ON ' . $table_or_view_name 




1932




 





 





 





 





 





 



             . (@transition_var_names ? ' REFERENCING ' . (join ' ', @transition_var_names) : $EMPTY_STR) 




1933




 





 





 





 





 





 



             . ($for_each_stmt ? ' FOR EACH STATEMENT' : ' FOR EACH ROW') 




1934




 





 





 





 





 





 



             # TODO: WHEN (  ) 




1935




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1936




 





 





 





 





 





 



             . $triggered_sql_statement 




1937




 





 





 





 





 





 



             . ';' . "\n"; 




1938




 





 





 





 





 





 



     } 




1939




 





 





 





 





 





 



     elsif ($routine_type eq 'PROCEDURE') { 




1940




 





 





 





 





 





 



         my $routine_args = $builder->build_dmanip_routine_args( $routine_node ); 




1941




 





 





 





 





 





 



         # TODO:  where appropriate. 




1942




 





 





 





 





 





 



         my $routine_body = $builder->build_dmanip_routine_body( $routine_node ); 




1943




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' PROCEDURE ' . $routine_name 




1944




 





 





 





 





 





 



             . $routine_args 




1945




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1946




 





 





 





 





 





 



             . ' ' . $routine_body . ';' . "\n"; 




1947




 





 





 





 





 





 



     } 




1948




 





 





 





 





 





 



     elsif ($routine_type eq 'FUNCTION') { 




1949




 





 





 





 





 





 



         my $routine_args = $builder->build_dmanip_routine_args( $routine_node ); 




1950




 





 





 





 





 





 



         # TODO:  where appropriate. 




1951




 





 





 





 





 





 



         my $routine_body = $builder->build_dmanip_routine_body( $routine_node ); 




1952




 





 





 





 





 





 



         my $return_cont_type = $routine_node->get_attribute( 'return_cont_type' ); 




1953




 





 





 





 





 





 



         my $return_data_type = $EMPTY_STR; 




1954




 





 





 





 





 





 



         if ($return_cont_type eq 'ERROR') { 




1955




 





 





 





 





 





 



             # Not implemented yet. 




1956




 





 





 





 





 





 



         } 




1957




 





 





 





 





 





 



         elsif ($return_cont_type eq 'SCALAR') { 




1958




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_scalar_data_type' ); 




1959




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




1960




 





 





 





 





 





 



         } 




1961




 





 





 





 





 





 



         elsif ($return_cont_type eq 'ROW') { 




1962




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_row_data_type' ); 




1963




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




1964




 





 





 





 





 





 



         } 




1965




 





 





 





 





 





 



         elsif ($return_cont_type eq 'SC_ARY') { 




1966




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_scalar_data_type' ); 




1967




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ) . ' ARRAY'; 




1968




 





 





 





 





 





 



         } 




1969




 





 





 





 





 





 



         elsif ($return_cont_type eq 'RW_ARY') { 




1970




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_row_data_type' ); 




1971




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ) . ' ARRAY'; 




1972




 





 





 





 





 





 



         } 




1973




 





 





 





 





 





 



         elsif ($return_cont_type eq 'CONN') { 




1974




 





 





 





 





 





 



             # Not implemented yet. 




1975




 





 





 





 





 





 



         } 




1976




 





 





 





 





 





 



         elsif ($return_cont_type eq 'CURSOR') { 




1977




 





 





 





 





 





 



             # Not implemented yet. 




1978




 





 





 





 





 





 



         } 




1979




 





 





 





 





 





 



         elsif ($return_cont_type eq 'LIST') { 




1980




 





 





 





 





 





 



             # Not implemented yet. 




1981




 





 





 





 





 





 



         } 




1982




 





 





 





 





 





 



         else {} 




1983




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' FUNCTION ' . $routine_name 




1984




 





 





 





 





 





 



             . $routine_args 




1985




 





 





 





 





 





 



             . ' RETURNS ' . $return_data_type 




1986




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1987




 





 





 





 





 





 



             . ' ' . $routine_body . ';' . "\n"; 




1988




 





 





 





 





 





 



     } 




1989




 





 





 





 





 





 



     else {} # $routine_type eq 'BLOCK' 




1990




 





 





 





 





 





 



         # 'BLOCK': no-op; you should call build_dmanip_routine_body() directly instead 




1991




 





 





 





 





 





 



 } 




1992




 





 





 





 





 





 



   




1993




 





 





 





 





 





 



 sub build_schema_or_app_routine_delete { 




1994




 





 





 





 





 





 



     # SQL:2003, 11.40 "" (p633) 




1995




 





 





 





 





 





 



     # SQL:2003, 11.52 "" (p703) 




1996




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




1997




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_routine_delete', 




1998




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




1999




 





 





 





 





 





 



     my $routine_type = $routine_node->get_attribute( 'routine_type' ); 




2000




 





 





 





 





 





 



     my $routine_name = $builder->build_identifier_schema_or_app_obj( $routine_node, 1 ); 




2001




 





 





 





 





 





 



     # Note: 10.6 "" (p499) may be useful later. 




2002




 





 





 





 





 





 



     if ($routine_type eq 'PACKAGE') { 




2003




 





 





 





 





 





 



         # Not implemented yet. 




2004




 





 





 





 





 





 



     } 




2005




 





 





 





 





 





 



     elsif ($routine_type eq 'TRIGGER') { 




2006




 





 





 





 





 





 



         return 'DROP TRIGGER ' . $routine_name . ';' . "\n"; 




2007




 





 





 





 





 





 



     } 




2008




 





 





 





 





 





 



     elsif ($routine_type eq 'PROCEDURE') { 




2009




 





 





 





 





 





 



         return 'DROP PROCEDURE ' . $routine_name . ';' . "\n"; 




2010




 





 





 





 





 





 



     } 




2011




 





 





 





 





 





 



     elsif ($routine_type eq 'FUNCTION') { 




2012




 





 





 





 





 





 



         return 'DROP FUNCTION ' . $routine_name . ';' . "\n"; 




2013




 





 





 





 





 





 



     } 




2014




 





 





 





 





 





 



     else {} # $routine_type eq 'BLOCK'; no-op 




2015




 





 





 





 





 





 



 } 




2016




 





 





 





 





 





 



   




2017




 





 





 





 





 





 



 ###################################################################### 




2018




 





 





 





 





 





 



   




2019




 





 





 





 





 





 



 sub build_access_role_create { # SQL:2003, 12.4 "" (p743) 




2020




 





 





 





 





 





 



     my ($builder, $role_node) = @_; 




2021




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_role_create', 




2022




 





 





 





 





 





 



         'ROLE_NODE', ['role'], $role_node ); 




2023




 





 





 





 





 





 



     my $role_name = $builder->build_identifier_element( $role_node ); 




2024




 





 





 





 





 





 



     return 'CREATE ROLE ' . $role_name . ';' . "\n"; 




2025




 





 





 





 





 





 



 } 




2026




 





 





 





 





 





 



   




2027




 





 





 





 





 





 



 sub build_access_role_delete { # SQL:2003, 12.6 "" (p746) 




2028




 





 





 





 





 





 



     my ($builder, $role_node) = @_; 




2029




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_role_delete', 




2030




 





 





 





 





 





 



         'ROLE_NODE', ['role'], $role_node ); 




2031




 





 





 





 





 





 



     my $role_name = $builder->build_identifier_element( $role_node ); 




2032




 





 





 





 





 





 



     return 'DROP ROLE ' . $role_name . ';' . "\n"; 




2033




 





 





 





 





 





 



 } 




2034




 





 





 





 





 





 



   




2035




 





 





 





 





 





 



 ###################################################################### 




2036




 





 





 





 





 





 



   




2037




 





 





 





 





 





 



 sub build_access_grant { 




2038




 





 





 





 





 





 



     # Function returns empty string if given grantee has no privileges. 




2039




 





 





 





 





 





 



     # SQL:2003, 12.1 "" (p731) 




2040




 





 





 





 





 





 



     # SQL:2003, 12.2 "" (p736) 




2041




 





 





 





 





 





 



     # SQL:2003, 12.3 "" (p739) 




2042




 





 





 





 





 





 



     # SQL:2003, 12.5 "" (p744) 




2043




 





 





 





 





 





 



     my ($builder, $grantee_node) = @_; 




2044




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_grant', 




2045




 





 





 





 





 





 



         'GRANTEE_NODE', ['role','user'], $grantee_node ); 




2046




 





 





 





 





 





 



     my $node_type = $grantee_node->get_node_type(); 




2047




 





 





 





 





 





 



     my $grantee_name = $builder->build_identifier_schema_or_app_obj( $grantee_node ); 




2048




 





 





 





 





 





 



     if ($node_type eq 'role') { 




2049




 





 





 





 





 





 



         my @grant_stmts = (); 




2050




 





 





 





 





 





 



         for my $priv_on_node (@{$grantee_node->get_child_nodes( 'privilege_on' )}) { 




2051




 





 





 





 





 





 



             my $object_node = $priv_on_node->get_attribute( 'si_priv_on' ); 




2052




 





 





 





 





 





 



             my $object_name = $builder->build_identifier_schema_or_app_obj( $object_node ); 




2053




 





 





 





 





 





 



             my @priv_types = map { $_->get_attribute( 'si_priv_type' ) } 




2054




 





 





 





 





 





 



                 @{$priv_on_node->get_child_nodes( 'privilege_for' )}; 




2055




 





 





 





 





 





 



             my @object_privs = (); 




2056




 





 





 





 





 





 



             if (grep { $_ eq 'ALL' } @priv_types) { 




2057




 





 





 





 





 





 



                 push @object_privs, 'ALL PRIVILEGES'; 




2058




 





 





 





 





 





 



             } 




2059




 





 





 





 





 





 



             else { 




2060




 





 





 





 





 





 



                 for my $priv_type (@priv_types) { 




2061




 





 





 





 





 





 



                     push @object_privs, 




2062




 





 





 





 





 





 



                            $priv_type eq 'SELECT' ? 'SELECT' # TODO: allow only specific columns 




2063




 





 





 





 





 





 



                          : $priv_type eq 'DELETE' ? 'DELETE' 




2064




 





 





 





 





 





 



                          : $priv_type eq 'INSERT' ? 'INSERT' # TODO: allow only specific columns 




2065




 





 





 





 





 





 



                          : $priv_type eq 'UPDATE' ? 'UPDATE' # TODO: allow only specific columns 




2066




 





 





 





 





 





 



                          :                          $EMPTY_STR # TODO: REFERENCES, USAGE, TRIGGER, UNDER, EXECUTE; what do they mean? 




2067




 





 





 





 





 





 



                          ; 




2068




 





 





 





 





 





 



                 } 




2069




 





 





 





 





 





 



             } 




2070




 





 





 





 





 





 



             push @grant_stmts, 'GRANT ' . (join q{, }, @object_privs) 




2071




 





 





 





 





 





 



                 . ' ON ' . $object_name . ' TO ' . $grantee_name . ';'; 




2072




 





 





 





 





 





 



         } 




2073




 





 





 





 





 





 



         return join $EMPTY_STR, @grant_stmts; 




2074




 





 





 





 





 





 



     } 




2075




 





 





 





 





 





 



     elsif ($node_type eq 'user') { 




2076




 





 





 





 





 





 



         my @role_names = map { $builder->build_identifier_schema_or_app_obj( $_ ) } 




2077




 





 





 





 





 





 



             @{$grantee_node->get_child_nodes( 'user_role' )}; 




2078




 





 





 





 





 





 



         return @role_names ? 'GRANT ' . (join q{, }, @role_names) . ' TO ' . $grantee_name . ';' : $EMPTY_STR; 




2079




 





 





 





 





 





 



     } 




2080




 





 





 





 





 





 



     else {} 




2081




 





 





 





 





 





 



 } 




2082




 





 





 





 





 





 



   




2083




 





 





 





 





 





 



 sub build_access_revoke { 




2084




 





 





 





 





 





 



     # SQL:2003, 12.7 "" (p747) 




2085




 





 





 





 





 





 



     # SQL:2003, 12.3 "" (p739) 




2086




 





 





 





 





 





 



     my ($builder, $grantee_node) = @_; 




2087




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_revoke', 




2088




 





 





 





 





 





 



         'GRANTEE_NODE', ['role','user'], $grantee_node ); 




2089




 





 





 





 





 





 



     my $node_type = $grantee_node->get_node_type(); 




2090




 





 





 





 





 





 



     my $grantee_name = $builder->build_identifier_schema_or_app_obj( $grantee_node ); 




2091




 





 





 





 





 





 



     if ($node_type eq 'role') { 




2092




 





 





 





 





 





 



         my @revoke_stmts = (); 




2093




 





 





 





 





 





 



         for my $priv_on_node (@{$grantee_node->get_child_nodes( 'privilege_on' )}) { 




2094




 





 





 





 





 





 



             my $object_node = $priv_on_node->get_attribute( 'si_priv_on' ); 




2095




 





 





 





 





 





 



             my $object_name = $builder->build_identifier_schema_or_app_obj( $object_node ); 




2096




 





 





 





 





 





 



             push @revoke_stmts, 'REVOKE ALL PRIVILEGES' 




2097




 





 





 





 





 





 



                 . ' ON ' . $object_name . ' FROM ' . $grantee_name . ';'; 




2098




 





 





 





 





 





 



         } 




2099




 





 





 





 





 





 



         return join $EMPTY_STR, @revoke_stmts; 




2100




 





 





 





 





 





 



     } 




2101




 





 





 





 





 





 



     elsif ($node_type eq 'user') { 




2102




 





 





 





 





 





 



         my @role_names = map { $builder->build_identifier_schema_or_app_obj( $_ ) } 




2103




 





 





 





 





 





 



             @{$grantee_node->get_child_nodes( 'user_role' )}; 




2104




 





 





 





 





 





 



         return @role_names ? 'REVOKE ' . (join q{, }, @role_names) . ' FROM ' . $grantee_name . ';' : $EMPTY_STR; 




2105




 





 





 





 





 





 



     } 




2106




 





 





 





 





 





 



     else {} 




2107




 





 





 





 





 





 



 } 




2108




 





 





 





 





 





 



   




2109




 





 





 





 





 





 



 ###################################################################### 




2110




 





 





 





 





 





 



   




2111




 





 





 





 





 





 



 sub build_dmanip_routine_args { 




2112




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




2113




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_args', 




2114




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




2115




 





 





 





 





 





 



     # SQL:2003, 11.50 "" (p675) 




2116




 





 





 





 





 





 



     # in particular see  




2117




 





 





 





 





 





 



     my @rtn_arg_declare_sql = (); 




2118




 





 





 





 





 





 



     for my $rtn_arg_node (@{$routine_node->get_child_nodes( 'routine_arg' )}) { 




2119




 





 





 





 





 





 



         # TODO:  ::= IN | OUT | INOUT 




2120




 





 





 





 





 





 



         my $arg_name = $builder->build_identifier_element( $rtn_arg_node ); 




2121




 





 





 





 





 





 



         my $cont_type = $rtn_arg_node->get_attribute( 'cont_type' ); 




2122




 





 





 





 





 





 



         if ($cont_type eq 'ERROR') { 




2123




 





 





 





 





 





 



             # Not implemented yet. 




2124




 





 





 





 





 





 



         } 




2125




 





 





 





 





 





 



         elsif ($cont_type eq 'SCALAR') { 




2126




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'scalar_data_type' ); 




2127




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2128




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ';'; 




2129




 





 





 





 





 





 



         } 




2130




 





 





 





 





 





 



         elsif ($cont_type eq 'ROW') { 




2131




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'row_data_type' ); 




2132




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2133




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ';'; 




2134




 





 





 





 





 





 



         } 




2135




 





 





 





 





 





 



         elsif ($cont_type eq 'SC_ARY') { 




2136




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'scalar_data_type' ); 




2137




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2138




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2139




 





 





 





 





 





 



         } 




2140




 





 





 





 





 





 



         elsif ($cont_type eq 'RW_ARY') { 




2141




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'row_data_type' ); 




2142




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2143




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2144




 





 





 





 





 





 



         } 




2145




 





 





 





 





 





 



         elsif ($cont_type eq 'CONN') { 




2146




 





 





 





 





 





 



             # Not implemented yet. 




2147




 





 





 





 





 





 



         } 




2148




 





 





 





 





 





 



         elsif ($cont_type eq 'CURSOR') { 




2149




 





 





 





 





 





 



             # Not implemented yet. 




2150




 





 





 





 





 





 



         } 




2151




 





 





 





 





 





 



         elsif ($cont_type eq 'LIST') { 




2152




 





 





 





 





 





 



             # Not implemented yet. 




2153




 





 





 





 





 





 



         } 




2154




 





 





 





 





 





 



         else {} 




2155




 





 





 





 





 





 



     } 




2156




 





 





 





 





 





 



     return @rtn_arg_declare_sql ? '(' . (join q{, }, @rtn_arg_declare_sql) . ')' : $EMPTY_STR; 




2157




 





 





 





 





 





 



 } 




2158




 





 





 





 





 





 



   




2159




 





 





 





 





 





 



 sub build_dmanip_routine_body { 




2160




 





 





 





 





 





 



     # Corresponds to these sections: 




2161




 





 





 





 





 





 



     # ? 




2162




 





 





 





 





 





 



     # SQL:2003, 6.1 "" (p161) 




2163




 





 





 





 





 





 



     # SQL:2003, 13.5 "" (p790) 




2164




 





 





 





 





 





 



     # SQL:2003, 14.1 "" (p809) 




2165




 





 





 





 





 





 



     my ($builder, $routine_node, $is_atomic) = @_; 




2166




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_body', 




2167




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




2168




 





 





 





 





 





 



     my $is_ora_routines = $builder->{$PROP_ORA_ROUTINES}; 




2169




 





 





 





 





 





 



     my @rtn_var_declare_sql = (); 




2170




 





 





 





 





 





 



     for my $rtn_var_node (@{$routine_node->get_child_nodes( 'routine_var' )}) { 




2171




 





 





 





 





 





 



         my $var_name = $builder->build_identifier_element( $rtn_var_node ); 




2172




 





 





 





 





 





 



         my $cont_type = $rtn_var_node->get_attribute( 'cont_type' ); 




2173




 





 





 





 





 





 



         if ($cont_type eq 'ERROR') { 




2174




 





 





 





 





 





 



             # Not implemented yet. 




2175




 





 





 





 





 





 



         } 




2176




 





 





 





 





 





 



         elsif ($cont_type eq 'SCALAR') { 




2177




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'scalar_data_type' ); 




2178




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2179




 





 





 





 





 





 



             my $init_lit_val = $rtn_var_node->get_attribute( 'init_lit_val' ); 




2180




 





 





 





 





 





 



             my $is_constant = $rtn_var_node->get_attribute( 'is_constant' ); 




2181




 





 





 





 





 





 



             push @rtn_var_declare_sql, 




2182




 





 





 





 





 





 



                 ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') 




2183




 





 





 





 





 





 



                 . $var_name . ' ' . $dt_or_dom_sql 




2184




 





 





 





 





 





 



                 # TODO: use $is_constant 




2185




 





 





 





 





 





 



                 . (defined $init_lit_val ? ' DEFAULT ' . $builder->quote_literal( $init_lit_val, 




2186




 





 





 





 





 





 



                     $builder->_scalar_data_type_of_node( $rtn_var_node )->get_attribute( 'base_type' ) ) : $EMPTY_STR) 




2187




 





 





 





 





 





 



                 . ';' 




2188




 





 





 





 





 





 



             ; 




2189




 





 





 





 





 





 



         } 




2190




 





 





 





 





 





 



         elsif ($cont_type eq 'ROW') { 




2191




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'row_data_type' ); 




2192




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2193




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ';'; 




2194




 





 





 





 





 





 



         } 




2195




 





 





 





 





 





 



         elsif ($cont_type eq 'SC_ARY') { 




2196




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'scalar_data_type' ); 




2197




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2198




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2199




 





 





 





 





 





 



         } 




2200




 





 





 





 





 





 



         elsif ($cont_type eq 'RW_ARY') { 




2201




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'row_data_type' ); 




2202




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2203




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2204




 





 





 





 





 





 



         } 




2205




 





 





 





 





 





 



         elsif ($cont_type eq 'CONN') { 




2206




 





 





 





 





 





 



             # Not implemented yet. 




2207




 





 





 





 





 





 



         } 




2208




 





 





 





 





 





 



         elsif ($cont_type eq 'CURSOR') { 




2209




 





 





 





 





 





 



             if (my $view_node = (@{$rtn_var_node->get_child_nodes( 'view' )})[0]) { 




2210




 





 





 





 





 





 



                 # Since we got here, cursor will be defined within curr rtn, regardless of share or not. 




2211




 





 





 





 





 





 



                 my $query_expr = $builder->build_query_query_expr( $view_node ); 




2212




 





 





 





 





 





 



                 my $order_by_clause = $builder->build_query_window_clause( $view_node ); 




2213




 





 





 





 





 





 



                 my $updatability_clause 




2214




 





 





 





 





 





 



                     = $rtn_var_node->get_attribute( 'curs_for_update' ) ? 'FOR UPDATE' 




2215




 





 





 





 





 





 



                     :                                                     'FOR READ ONLY'; # TODO: [ OF  ] 




2216




 





 





 





 





 





 



                 # TODO: sensitivity, scrollability, holdability, returnability 




2217




 





 





 





 





 





 



                 my $cursor_spec = $query_expr . ' ' . $order_by_clause . ' ' . $updatability_clause; 




2218




 





 





 





 





 





 



                 push @rtn_var_declare_sql, 'DECLARE ' . $var_name . ' CURSOR FOR ' . $cursor_spec . ';'; 




2219




 





 





 





 





 





 



             } 




2220




 





 





 





 





 





 



             else { 




2221




 





 





 





 





 





 



                 # Not implemented yet; but also not sure of proper way to implement. 




2222




 





 





 





 





 





 



                 # If we got here then cursor had been declared in diff rtn and passed to curr one. 




2223




 





 





 





 





 





 



                 # We can't just make another copy of decl since may use vars/args/etc of other rtn. 




2224




 





 





 





 





 





 



                 push @rtn_var_declare_sql, 'DECLARE ' . $var_name . ';'; 




2225




 





 





 





 





 





 



             } 




2226




 





 





 





 





 





 



         } 




2227




 





 





 





 





 





 



         elsif ($cont_type eq 'LIST') { 




2228




 





 





 





 





 





 



             # Not implemented yet. 




2229




 





 





 





 





 





 



         } 




2230




 





 





 





 





 





 



         else {} 




2231




 





 





 





 





 





 



     } 




2232




 





 





 





 





 





 



     my @rtn_stmt_sql = (); 




2233




 





 





 





 





 





 



     for my $rtn_stmt_node (@{$routine_node->get_child_nodes( 'routine_stmt' )}) { 




2234




 





 





 





 





 





 



         push @rtn_stmt_sql, $builder->build_dmanip_routine_stmt( $rtn_stmt_node ); 




2235




 





 





 





 





 





 



     } 




2236




 





 





 





 





 





 



     my $atomic_clause = $is_atomic ? 'ATOMIC ' : $EMPTY_STR; 




2237




 





 





 





 





 





 



     return join ' ', 




2238




 





 





 





 





 





 



         # TODO: proper handling of vars declared within 'BLOCK' routines, when in Oracle syntax. 




2239




 





 





 





 





 





 



         ($is_ora_routines ? 'VAR ' : 'BEGIN ' . $atomic_clause), 




2240




 





 





 





 





 





 



         @rtn_var_declare_sql, 




2241




 





 





 





 





 





 



         ($is_ora_routines ? 'BEGIN ' . $atomic_clause : $EMPTY_STR), 




2242




 





 





 





 





 





 



         @rtn_stmt_sql, 




2243




 





 





 





 





 





 



         'END;' 




2244




 





 





 





 





 





 



     ; 




2245




 





 





 





 





 





 



 } 




2246




 





 





 





 





 





 



   




2247




 





 





 





 





 





 



 ###################################################################### 




2248




 





 





 





 





 





 



   




2249




 





 





 





 





 





 



 sub build_dmanip_routine_stmt { 




2250




 





 





 





 





 





 



     # SQL:2003, 13.5 "" (p790) 




2251




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2252




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_stmt', 




2253




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2254




 





 





 





 





 





 



     if (my $compound_stmt_routine = $rtn_stmt_node->get_attribute( 'block_routine' )) { 




2255




 





 





 





 





 





 



         return $builder->build_dmanip_routine_body( $compound_stmt_routine ); 




2256




 





 





 





 





 





 



     } 




2257




 





 





 





 





 





 



     elsif (my $assign_dest_node = $rtn_stmt_node->get_attribute( 'assign_dest' ) || 




2258




 





 





 





 





 





 



             $rtn_stmt_node->get_attribute( 'assign_dest' )) { 




2259




 





 





 





 





 





 



         my $dest = $builder->build_identifier_element( $assign_dest_node ); 




2260




 





 





 





 





 





 



         my $src = $builder->build_expr( 




2261




 





 





 





 





 





 



             $rtn_stmt_node->get_child_nodes( 'routine_expr' )->[0] ); 




2262




 





 





 





 





 





 



         if ($builder->{$PROP_ORA_ROUTINES}) { 




2263




 





 





 





 





 





 



             return $dest . ' := ' . $src . ';' . "\n"; 




2264




 





 





 





 





 





 



         } 




2265




 





 





 





 





 





 



         else { 




2266




 





 





 





 





 





 



             return 'SET ' . $dest . ' = ' . $src . ';' . "\n"; 




2267




 





 





 





 





 





 



         } 




2268




 





 





 





 





 





 



     } 




2269




 





 





 





 





 





 



     elsif ($rtn_stmt_node->get_attribute( 'call_sroutine' )) { 




2270




 





 





 





 





 





 



         return $builder->build_dmanip_call_sroutine( $rtn_stmt_node ); 




2271




 





 





 





 





 





 



     } 




2272




 





 





 





 





 





 



     elsif ($rtn_stmt_node->get_attribute( 'call_uroutine' )) { 




2273




 





 





 





 





 





 



         return $builder->build_dmanip_call_uroutine( $rtn_stmt_node ); 




2274




 





 





 





 





 





 



     } 




2275




 





 





 





 





 





 



     else {} 




2276




 





 





 





 





 





 



 } 




2277




 





 





 





 





 





 



   




2278




 





 





 





 





 





 



 ###################################################################### 




2279




 





 





 





 





 





 



   




2280




 





 





 





 





 





 



 sub build_dmanip_call_sroutine { 




2281




 





 





 





 





 





 



     # Corresponds to these sections: 




2282




 





 





 





 





 





 



     # SQL:2003, 14.2 "" (p815) 




2283




 





 





 





 





 





 



     # SQL:2003, 14.3 "" (p817) 




2284




 





 





 





 





 





 



     # SQL:2003, 14.4 "" (p822) 




2285




 





 





 





 





 





 



     # SQL:2003, 15.2 "" (p886) 




2286




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2287




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_call_sroutine', 




2288




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2289




 





 





 





 





 





 



     my $sroutine = $rtn_stmt_node->get_attribute( 'call_sroutine' ); 




2290




 





 





 





 





 





 



     my %child_exprs = map { ( 




2291




 





 





 





 





 





 



             ($_->get_attribute( 'call_sroutine_cxt' ) || 




2292




 





 





 





 





 





 



                 $_->get_attribute( 'call_sroutine_arg' )) => $_ 




2293




 





 





 





 





 





 



         ) } @{$rtn_stmt_node->get_child_nodes( 'routine_expr' )}; 




2294




 





 





 





 





 





 



     if ($sroutine eq 'RETURN') { 




2295




 





 





 





 





 





 



         my $return_value = $builder->build_expr( $child_exprs{'RETURN_VALUE'} ); 




2296




 





 





 





 





 





 



         return 'RETURN ' . $return_value . ';' . "\n"; # no parens in standard 




2297




 





 





 





 





 





 



     } 




2298




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_OPEN') { # opens a select cursor for reading from (or performs a select if in right context) 




2299




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2300




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2301




 





 





 





 





 





 



         return 'OPEN ' . $cursor_cx_name . ';' . "\n"; 




2302




 





 





 





 





 





 



     } 




2303




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_CLOSE') { # closes a select cursor when you're done with it 




2304




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2305




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2306




 





 





 





 





 





 



         return 'CLOSE ' . $cursor_cx_name . ';' . "\n"; 




2307




 





 





 





 





 





 



     } 




2308




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_FETCH') { # reads a row from an opened cursor and puts it in a row/list variable 




2309




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2310




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2311




 





 





 





 





 





 



         my $fetch_orient = $EMPTY_STR; # TODO: the explicit  options; NEXT is default 




2312




 





 





 





 





 





 



         my $query_dest_name = $builder->build_identifier_element( 




2313




 





 





 





 





 





 



             $child_exprs{'INTO'}->get_attribute( 'query_dest' ) ); 




2314




 





 





 





 





 





 



         return 'FETCH ' . $fetch_orient . ' FROM ' . $cursor_cx_name . ' INTO ' . $query_dest_name . ';' . "\n"; 




2315




 





 





 





 





 





 



     } 




2316




 





 





 





 





 





 



     elsif ($sroutine eq 'SELECT') { # fetches one row from a table/view and puts it in a row/list variable 




2317




 





 





 





 





 





 



         my $view_node = $child_exprs{'SELECT_DEFN'}->get_attribute( 'act_on' ); 




2318




 





 





 





 





 





 



         return $builder->build_query_query_spec( $view_node, 




2319




 





 





 





 





 





 



             $child_exprs{'INTO'}->get_attribute( 'query_dest' ) ) . ';' . "\n"; 




2320




 





 





 





 





 





 



     } 




2321




 





 





 





 





 





 



     elsif ($sroutine eq 'INSERT') { # inserts a row into a table/view 




2322




 





 





 





 





 





 



         my $view_node = $child_exprs{'INSERT_DEFN'}->get_attribute( 'act_on' ); 




2323




 





 





 





 





 





 



         return $builder->build_dmanip_insert_stmt( $view_node ); 




2324




 





 





 





 





 





 



     } 




2325




 





 





 





 





 





 



     elsif ($sroutine eq 'UPDATE') { # updates a row in a table/view 




2326




 





 





 





 





 





 



         my $view_node = $child_exprs{'UPDATE_DEFN'}->get_attribute( 'act_on' ); 




2327




 





 





 





 





 





 



         return $builder->build_dmanip_update_stmt( $view_node ); 




2328




 





 





 





 





 





 



     } 




2329




 





 





 





 





 





 



     elsif ($sroutine eq 'DELETE') { # deletes a row in a table/view 




2330




 





 





 





 





 





 



         my $view_node = $child_exprs{'DELETE_DEFN'}->get_attribute( 'act_on' ); 




2331




 





 





 





 





 





 



         return $builder->build_dmanip_delete_stmt( $view_node ); 




2332




 





 





 





 





 





 



     } 




2333




 





 





 





 





 





 



     elsif ($sroutine eq 'COMMIT') { # commits the current transaction, then starts a new one 




2334




 





 





 





 





 





 



         return 'COMMIT; START TRANSACTION;' . "\n"; 




2335




 





 





 





 





 





 



         # Note: According to the MySQL manual: 




2336




 





 





 





 





 





 



         # For transaction-safe tables, there are actions (other than typing COMMIT) 




2337




 





 





 





 





 





 



         # that will automatically trigger a COMMIT. Requesting a lock will implicitly 




2338




 





 





 





 





 





 



         # commit any outstanding queries. 




2339




 





 





 





 





 





 



     } 




2340




 





 





 





 





 





 



     elsif ($sroutine eq 'ROLLBACK') { # rolls back the current transaction, then starts a new one 




2341




 





 





 





 





 





 



         return 'ROLLBACK; START TRANSACTION;' . "\n"; # TODO: rollback to a named save point only 




2342




 





 





 





 





 





 



     } 




2343




 





 





 





 





 





 



     else {} # There are a bunch more that aren't implemented yet. 




2344




 





 





 





 





 





 



 } 




2345




 





 





 





 





 





 



   




2346




 





 





 





 





 





 



 ###################################################################### 




2347




 





 





 





 





 





 



   




2348




 





 





 





 





 





 



 sub build_dmanip_src_schema_object_name { 




2349




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2350




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_src_schema_object_name', 




2351




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2352




 





 





 





 





 





 



     my $view_type = $view_node->get_attribute( 'view_type' ); 




2353




 





 





 





 





 





 



     my @view_src_nodes = @{$view_node->get_child_nodes( 'view_src' )}; 




2354




 





 





 





 





 





 



     if (@view_src_nodes == 0) { 




2355




 





 





 





 





 





 



         return; # No source at all. 




2356




 





 





 





 





 





 



     } 




2357




 





 





 





 





 





 



     elsif ($view_type eq 'ALIAS' or @view_src_nodes == 1) { 




2358




 





 





 





 





 





 



         my $object_node = $view_src_nodes[0]->get_attribute( 'match' ); 




2359




 





 





 





 





 





 



         if ($object_node->get_primary_parent_attribute()->get_node_type() eq 'schema') { 




2360




 





 





 





 





 





 



             # The only source is a schema object, table or named view; use it directly. 




2361




 





 





 





 





 





 



             return $builder->build_identifier_schema_or_app_obj( $object_node ); 




2362




 





 





 





 





 





 



         } 




2363




 





 





 





 





 





 



         else { 




2364




 





 





 





 





 





 



             # The only source seems to be a sub-query in "from". 




2365




 





 





 





 





 





 



             return; # Adding recursion in all necessary places too complicated for now. 




2366




 





 





 





 





 





 



         } 




2367




 





 





 





 





 





 



     } 




2368




 





 





 





 





 





 



     else { # @view_src_nodes >= 2 




2369




 





 





 





 





 





 



         return; # Manual updates against multiple sources too complicated for now. 




2370




 





 





 





 





 





 



     } 




2371




 





 





 





 





 





 



 } 




2372




 





 





 





 





 





 



   




2373




 





 





 





 





 





 



 ###################################################################### 




2374




 





 





 





 





 





 



   




2375




 





 





 





 





 





 



 sub build_dmanip_insert_stmt { 




2376




 





 





 





 





 





 



     # SQL:2003, 7.3 "" (p298) 




2377




 





 





 





 





 





 



     # SQL:2003, 14.8 "" (p834) 




2378




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2379




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_insert_stmt', 




2380




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2381




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2382




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2383




 





 





 





 





 





 



     my @set_expr_nodes 




2384




 





 





 





 





 





 



         = grep { $_->get_attribute( 'view_part' ) eq 'SET' } 




2385




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




2386




 





 





 





 





 





 



     my @set_fields_list = (); 




2387




 





 





 





 





 





 



     my @set_values_list = (); 




2388




 





 





 





 





 





 



     for my $expr_node (@set_expr_nodes) { 




2389




 





 





 





 





 





 



         push @set_fields_list, $builder->build_identifier_element( 




2390




 





 





 





 





 





 



             $expr_node->get_attribute( 'set_src_field' ) ); 




2391




 





 





 





 





 





 



         push @set_values_list, $builder->build_expr( $expr_node ); 




2392




 





 





 





 





 





 



     } 




2393




 





 





 





 





 





 



     my $insert_fields_and_src = '(' . (join q{, }, @set_fields_list) . ') ' 




2394




 





 





 





 





 





 



         . 'VALUES (' . (join q{, }, @set_values_list) . ')'; 




2395




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2396




 





 





 





 





 





 



     return 'INSERT INTO ' . $object_name . ' ' . $insert_fields_and_src . ';' . "\n"; 




2397




 





 





 





 





 





 



 } 




2398




 





 





 





 





 





 



   




2399




 





 





 





 





 





 



 ###################################################################### 




2400




 





 





 





 





 





 



   




2401




 





 





 





 





 





 



 sub build_dmanip_update_stmt { 




2402




 





 





 





 





 





 



     # SQL:2003, 14.11 "" (p849) 




2403




 





 





 





 





 





 



     # SQL:2003, 14.12 "" (p853) 




2404




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2405




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_update_stmt', 




2406




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2407




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2408




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2409




 





 





 





 





 





 



     my @set_expr_nodes 




2410




 





 





 





 





 





 



         = grep { $_->get_attribute( 'view_part' ) eq 'SET' } 




2411




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




2412




 





 





 





 





 





 



     my @set_clause_list = (); 




2413




 





 





 





 





 





 



     for my $expr_node (@set_expr_nodes) { 




2414




 





 





 





 





 





 



         my $set_target = $builder->build_identifier_element( 




2415




 





 





 





 





 





 



             $expr_node->get_attribute( 'set_src_field' ) ); 




2416




 





 





 





 





 





 



         my $update_source = $builder->build_expr( $expr_node ); 




2417




 





 





 





 





 





 



         push @set_clause_list, $set_target . ' = ' . $update_source; 




2418




 





 





 





 





 





 



     } 




2419




 





 





 





 





 





 



     my $set_clause = 'SET ' . (join q{, }, @set_clause_list); 




2420




 





 





 





 





 





 



     my $where_clause = $builder->build_query_where_clause( $view_node ); 




2421




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2422




 





 





 





 





 





 



     return 'UPDATE ' . $object_name . ' ' . $set_clause . ' ' . $where_clause . ';' . "\n"; 




2423




 





 





 





 





 





 



 } 




2424




 





 





 





 





 





 



   




2425




 





 





 





 





 





 



 ###################################################################### 




2426




 





 





 





 





 





 



   




2427




 





 





 





 





 





 



 sub build_dmanip_delete_stmt { # SQL:2003, 14.7 "" (p831) 




2428




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2429




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_delete_stmt', 




2430




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2431




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2432




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2433




 





 





 





 





 





 



     my $where_clause = $builder->build_query_where_clause( $view_node ); 




2434




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2435




 





 





 





 





 





 



     return 'DELETE FROM ' . $object_name . ' ' . $where_clause . ';' . "\n"; 




2436




 





 





 





 





 





 



 } 




2437




 





 





 





 





 





 



   




2438




 





 





 





 





 





 



 ###################################################################### 




2439




 





 





 





 





 





 



   




2440




 





 





 





 





 





 



 sub build_dmanip_call_uroutine { 




2441




 





 





 





 





 





 



     # SQL:2003 ...  ... 




2442




 





 





 





 





 





 



     # SQL:2003, 15.1 "" (p885) 




2443




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2444




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_call_uroutine', 




2445




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2446




 





 





 





 





 





 



     my $uroutine = $rtn_stmt_node->get_attribute( 'call_uroutine' ); 




2447




 





 





 





 





 





 



     my $uroutine_name = $builder->build_identifier_schema_or_app_obj( $uroutine ); 




2448




 





 





 





 





 





 



     my %uroutine_arg_exprs 




2449




 





 





 





 





 





 



         = map { ($_->get_attribute( 'call_uroutine_arg' )->get_self_id() => $_) } 




2450




 





 





 





 





 





 



           @{$rtn_stmt_node->get_child_nodes( 'routine_expr' )}; 




2451




 





 





 





 





 





 



     # Note: The build_expr() calls are done below to ensure the arg values are 




2452




 





 





 





 





 





 



     # defined in the same order they are output; this lets optional insertion 




2453




 





 





 





 





 





 



     # of positionally determined host params (and their mapping) to work right. 




2454




 





 





 





 





 





 



     my $arg_val_list = join q{, }, 




2455




 





 





 





 





 





 



         map { $uroutine_arg_exprs{$_->get_self_id()} 




2456




 





 





 





 





 





 



               ? $builder->build_expr( $uroutine_arg_exprs{$_->get_self_id()} ) 




2457




 





 





 





 





 





 



               : 'NULL' } 




2458




 





 





 





 





 





 



         @{$uroutine->get_child_nodes( 'routine_arg' )}; 




2459




 





 





 





 





 





 



     #  ::= CALL  




2460




 





 





 





 





 





 



     return 'CALL ' . $uroutine_name . ($arg_val_list ? '(' . $arg_val_list . ')' : $EMPTY_STR) . ';' . "\n"; 




2461




 





 





 





 





 





 



 } 




2462




 





 





 





 





 





 



   




2463




 





 





 





 





 





 



 ###################################################################### 




2464




 





 





 





 





 





 



   




2465




 





 





 





 





 





 



 sub substitute_macros { 




2466




 





 





 





 





 





 



     my ($builder, $str, $subs) = @_; 




2467




 





 





 





 





 





 



     while (my ($key,$value) = each %{$subs}) { 




2468




 





 





 





 





 





 



         $str =~ s/ \{ $key \} /$value/x; 




2469




 





 





 





 





 





 



     } 




2470




 





 





 





 





 





 



     return $str; 




2471




 





 





 





 





 





 



 } 




2472




 





 





 





 





 





 



   




2473




 





 





 





 





 





 



 ###################################################################### 




2474




 





 





 





 





 





 



   




2475




 





 





 





 





 





 



 sub find_scalar_domain_for_row_domain_field { 




2476




 





 





 





 





 





 



     my ($builder, $scalar_data_type_node, $row_domain_node) = @_; 




2477




 





 





 





 





 





 



     my @candidates = grep { $_->get_attribute( 'data_type' )->get_self_id() eq $scalar_data_type_node->get_self_id() } 




2478




 





 





 





 





 





 



         @{$row_domain_node->get_primary_parent_attribute()->get_child_nodes( 'scalar_domain' )}; 




2479




 





 





 





 





 





 



     return $candidates[0] || $scalar_data_type_node; 




2480




 





 





 





 





 





 



 } 




2481




 





 





 





 





 





 



   




2482




 





 





 





 





 





 



 ###################################################################### 




2483




 





 





 





 





 





 



   




2484




 





 





 





 





 





 



 sub _scalar_data_type_of_node { 




2485




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2486




 





 





 





 





 





 



     $atnm ||= 'scalar_data_type'; 




2487




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2488




 





 





 





 





 





 



     if ($dt_or_dom_node->get_node_type() eq 'scalar_domain') { 




2489




 





 





 





 





 





 



         $dt_or_dom_node = $dt_or_dom_node->get_attribute( 'data_type' ); 




2490




 





 





 





 





 





 



     } 




2491




 





 





 





 





 





 



     return $dt_or_dom_node; 




2492




 





 





 





 





 





 



 } 




2493




 





 





 





 





 





 



   




2494




 





 





 





 





 





 



 sub _row_data_type_of_node { 




2495




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2496




 





 





 





 





 





 



     $atnm ||= 'row_data_type'; 




2497




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2498




 





 





 





 





 





 



     if ($dt_or_dom_node->get_node_type() eq 'row_domain') { 




2499




 





 





 





 





 





 



         $dt_or_dom_node = $dt_or_dom_node->get_attribute( 'data_type' ); 




2500




 





 





 





 





 





 



     } 




2501




 





 





 





 





 





 



     return $dt_or_dom_node; 




2502




 





 





 





 





 





 



 } 




2503




 





 





 





 





 





 



   




2504




 





 





 





 





 





 



 sub _row_domain_of_node { 




2505




 





 





 





 





 





 



     # returns domain or nothing 




2506




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2507




 





 





 





 





 





 



     $atnm ||= 'row_data_type'; 




2508




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2509




 





 





 





 





 





 



     return $dt_or_dom_node 




2510




 





 





 





 





 





 



         if $dt_or_dom_node->get_node_type() eq 'row_domain'; 




2511




 





 





 





 





 





 



     return; 




2512




 





 





 





 





 





 



 } 




2513




 





 





 





 





 





 



   




2514




 





 





 





 





 





 



 ###################################################################### 




2515




 





 





 





 





 





 



 # This is a 'protected' method; only sub-classes should invoke it. 




2516




 





 





 





 





 





 



   




2517




 





 





 





 





 





 



 sub _throw_error_message { 




2518




 





 





 





 





 





 



     my ($builder, $msg_key, $msg_vars) = @_; 




2519




 





 





 





 





 





 



     # Throws an exception consisting of an object. 




2520




 





 





 





 





 





 



     ref $msg_vars eq 'HASH' or $msg_vars = {}; 




2521




 





 





 





 





 





 



     for my $var_key (keys %{$msg_vars}) { 




2522




 





 





 





 





 





 



         if (ref $msg_vars->{$var_key} eq 'ARRAY') { 




2523




 





 





 





 





 





 



             $msg_vars->{$var_key} = 'PERL_ARRAY:[' . (join q{,},map {$_||$EMPTY_STR} @{$msg_vars->{$var_key}}) . ']'; 




2524




 





 





 





 





 





 



         } 




2525




 





 





 





 





 





 



     } 




2526




 





 





 





 





 





 



     die Locale::KeyedText->new_message( $msg_key, $msg_vars ); 




2527




 





 





 





 





 





 



 } 




2528




 





 





 





 





 





 



   




2529




 





 





 





 





 





 



 sub _assert_arg_node_type { 




2530




 





 





 





 





 





 



     my ($builder, $meth_name, $arg_name, $exp_node_types, $arg_value) = @_; 




2531




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_UNDEF', 




2532




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name } ) 




2533




 





 





 





 





 





 



         if !defined $arg_value; 




2534




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_NO_NODE', 




2535




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name, 'ARGVL' => $arg_value } ) 




2536




 





 





 





 





 





 



         if !ref $arg_value or !UNIVERSAL::isa( $arg_value, 'Rosetta::Model::Node' ); 




2537




 





 





 





 





 





 



     return 




2538




 





 





 





 





 





 



         if @{$exp_node_types} == 0; # any Node type is acceptable 




2539




 





 





 





 





 





 



     my $given_node_type = $arg_value->get_node_type(); 




2540




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_WRONG_NODE_TYPE', 




2541




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name, 




2542




 





 





 





 





 





 



         'EXPNTYPE' => $exp_node_types, 'ARGNTYPE' => $given_node_type } ) 




2543




 





 





 





 





 





 



         if !grep { $given_node_type eq $_ } @{$exp_node_types}; 




2544




 





 





 





 





 





 



     # If we get here, $arg_value is acceptable to the method. 




2545




 





 





 





 





 





 



 } 




2546




 





 





 





 





 





 



   




2547




 





 





 





 





 





 



 ###################################################################### 




2548




 





 





 





 





 





 



 ###################################################################### 




2549




 





 





 





 





 





 



   




2550




 





 





 





 





 





 



 1; 




2551




 





 





 





 





 





 



 __END__
    my ($builder, $view_src_node) = @_;
    $builder->_assert_arg_node_type( 'build_query_table_factor',
        'VIEW_SRC_NODE', ['view_src'], $view_src_node );
    # Maybe TODO:
    my $correlation_name = $builder->build_identifier_element( $view_src_node );
    my $match_node = $view_src_node->get_attribute( 'match' );
    my $match_name = $builder->build_identifier_schema_or_app_obj( $match_node );
    if ($match_node->get_node_type() eq 'view') {
        if ($match_node->get_primary_parent_attribute()->get_node_type() eq 'view') {
            # The view we are matching is a subquery.
            if ($builder->{$PROP_INLINE_SUBQ}) {
                # Embed an anonymous subquery; argument passing is not yet supported.
                my $query_expression = $builder->build_query_query_expr( $match_node );
                return '(' . $query_expression . ') AS ' . $correlation_name;
            }
            else {
                # Call a named subquery; argument passing is supported.
                my %src_args_to_view_exprs
                    = map { ($_->get_attribute( 'call_src_arg' )->get_self_id() => $_) }
                      grep { $_->get_attribute( 'view_part' ) eq 'FROM' }
                      @{$view_src_node->get_primary_parent_attribute()->get_child_nodes( 'view_expr' )};
                my %view_args_to_src_args
                    = map { ($_->get_attribute( 'match_view_arg' )->get_self_id() => $_) }
                      @{$view_src_node->get_child_nodes( 'view_src_arg' )};
                # Note: The build_expr() calls are done below to ensure the arg values are
                # defined in the same order they are output; this lets optional insertion
                # of positionally determined host params (and their mapping) to work right.
                my $arg_list = join q{, },
                    map { ($_ ? $builder->build_expr( $_ ) : 'NULL') }
                    map { $src_args_to_view_exprs{$view_args_to_src_args{$_->get_self_id()}->get_self_id()} }
                    @{$match_node->get_child_nodes( 'view_arg' )};
                return $match_name
                       . ($arg_list ? '(' . $arg_list . ')' : $EMPTY_STR)
                       . ' AS ' . $correlation_name;
            }
        }
        else {
            # The view we are matching is a schema object.
            return $match_name . ' AS ' . $correlation_name;
        }
    }
    else { # the source node is a base table schema object or a local variable of some kind
        return $match_name . ' AS ' . $correlation_name;
    }
}

######################################################################

sub build_query_where_clause { # SQL:2003, 7.8 "" (p319)
    # Function returns empty string if view has no where clause.
    my ($builder, $view_node) = @_;
    $builder->_assert_arg_node_type( 'build_query_where_clause',
        'VIEW_NODE', ['view'], $view_node );
    my @expr_list
        = map { $builder->build_expr( $_ ) }
          grep { $_->get_attribute( 'view_part' ) eq 'WHERE' }
          @{$view_node->get_child_nodes( 'view_expr' )};
    return @expr_list ? "\n" . 'WHERE ' . $expr_list[0] : $EMPTY_STR;
}

######################################################################

sub build_query_group_clause { # SQL:2003, 7.9 "" (p320)
    # Function returns empty string if view has no group by clause.
    my ($builder, $view_node) = @_;
    my @expr_list
        = map { $builder->build_expr( $_ ) }
          grep { $_->get_attribute( 'view_part' ) eq 'GROUP' }
          @{$view_node->get_child_nodes( 'view_expr' )};
    return @expr_list ? "\n" . 'GROUP BY ' . (join q{, }, @expr_list) : $EMPTY_STR;
    # Notes: Within build_expr():
    #  implemented by COL basic_expr_type,
    #  and  implemented by LIST basic_expr_type,
    #  impl by ROSMN named GB_SETS,
    #  impl by ROSMN named GB_RLUP,
    #  impl by ROSMN named GB_CUBE.
    # Note:  has opt , looks redundant w SEL DIST|ALL; not impl.
}

######################################################################

sub build_query_having_clause { # SQL:2003, 7.10 "" (p329)
    # Function returns empty string if view has no having clause.
    my ($builder, $view_node) = @_;
    $builder->_assert_arg_node_type( 'build_query_having_clause',
        'VIEW_NODE', ['view'], $view_node );
    my @expr_list
        = map { $builder->build_expr( $_ ) }
          grep { $_->get_attribute( 'view_part' ) eq 'HAVING' }
          @{$view_node->get_child_nodes( 'view_expr' )};
    return @expr_list ? "\n" . 'HAVING ' . $expr_list[0] : $EMPTY_STR;
}

######################################################################

sub build_query_window_clause { # SQL:2003, 7.11 "" (p331)
    # Function returns empty string if view has no window clause.
    my ($builder, $view_node) = @_;
    $builder->_assert_arg_node_type( 'build_query_window_clause',
        'VIEW_NODE', ['view'], $view_node );
    # TODO: I need to first update Rosetta::Model a bit re the various
    # parts of a , then fix here.  Meanwhile, I dump what I got.
    # Also see SQL:2003, 10.10 "" (p517) for future reference.
    my @order_list
        = map { $builder->build_expr( $_ ) }
          grep { $_->get_attribute( 'view_part' ) eq 'ORDER' }
          @{$view_node->get_child_nodes( 'view_expr' )};
    my @maxr_list
        = map { $builder->build_expr( $_ ) }
          grep { $_->get_attribute( 'view_part' ) eq 'MAXR' }
          @{$view_node->get_child_nodes( 'view_expr' )};
    my @skipr_list
        = map { $builder->build_expr( $_ ) }
          grep { $_->get_attribute( 'view_part' ) eq 'SKIPR' }
          @{$view_node->get_child_nodes( 'view_expr' )};
    return (@order_list ? "\n" . 'ORDER BY ' . (join q{, }, @order_list) : $EMPTY_STR)
           . (@maxr_list ? "\n" . 'LIMIT ' . $maxr_list[0] : $EMPTY_STR)
           . (@skipr_list ? "\n" . 'OFFSET ' . $skipr_list[0] : $EMPTY_STR);
}

######################################################################

sub build_query_query_spec {
    # SQL:2003, 7.12 "" (p341)
    # SQL:2003, 14.5 "" (p824)
    my ($builder, $view_node, $into_dest_node) = @_;
    $builder->_assert_arg_node_type( 'build_query_query_spec',
        'VIEW_NODE', ['view'], $view_node );
    defined $into_dest_node and $builder->_assert_arg_node_type( 'build_query_query_spec',
        'INTO_DEST_NODE', ['routine_arg','routine_var'], $into_dest_node );
    # Method assumes that $view_node.view_type ne 'COMPOUND';
    # method should never be invoked for those kinds of views.
    my $set_quantifier = $view_node->get_attribute( 'distinct_rows' ) ? 'DISTINCT' : 'ALL';
    my $select_list = $builder->build_query_select_list( $view_node );
    my $into_clause = $into_dest_node ? "\n" . 'INTO ' . $builder->build_identifier_element( $into_dest_node ) : $EMPTY_STR;
    my $table_expression = $builder->build_query_table_expr( $view_node );
    return "\n" . 'SELECT ' . $set_quantifier . ' ' . $select_list . $into_clause . $table_expression;
}

######################################################################

sub build_query_select_list { # SQL:2003, 7.12 "" (p341)
    # Method returns comma-delimited list expression where each list item is a
    # " ::=  AS ".
    my ($builder, $view_node) = @_;
    $builder->_assert_arg_node_type( 'build_query_select_list',
        'VIEW_NODE', ['view'], $view_node );
    if ($view_node->get_attribute( 'view_type' ) eq 'ALIAS') {
        # Each result column must match a source column exactly.
        # Every source table/view result column or var field is output, with the same name.
        # It is assumed/required that the view has the same 'row_data_type' as the source.
        # While '*' would conceptually work here, we still explicitly enumerate col name list
        # so compound selects and select-intos don't break when original create tbl/vw statement
        # had declared columns in a different order than our row-data-type does.
        my $row_data_type_node = $builder->_row_data_type_of_node( $view_node );
        return join q{, } . "\n",
            map { $builder->build_identifier_element( $_ ) }
            @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )};
    }
    else { # view_type ne 'ALIAS'
        # Each result column may come from an arbitrarily complex expression.
        # We have three statements below instead of one because we want the result cols shown
        # in order of the view's "row_data_type_field" Nodes, not the order of the 'view_part' if different.
        my %select_list_view_fields
            = map { ($_->get_attribute( 'si_row_field' )->get_self_id() => $_->get_attribute( 'src_field' )) }
              @{$view_node->get_child_nodes( 'view_field' )}; # note: 'src_field' may be undefined
        my %select_list_view_exprs
            = map { ($_->get_attribute( 'set_result_field' )->get_self_id() => $_) }
              grep { $_->get_attribute( 'view_part' ) eq 'RESULT' }
              @{$view_node->get_child_nodes( 'view_expr' )};
        # Note: The build_expr() calls are done below to ensure the arg values are
        # defined in the same order they are output; this lets optional insertion
        # of positionally determined host params (and their mapping) to work right.
        my $row_data_type_node = $builder->_row_data_type_of_node( $view_node );
        return join q{, } . "\n",
            map { ($select_list_view_fields{$_->get_self_id()}
                   ? $builder->build_identifier_view_src_field( $select_list_view_fields{$_->get_self_id()} )
                   : $select_list_view_exprs{$_->get_self_id()}
                   ? $builder->build_expr( $select_list_view_exprs{$_->get_self_id()} )
                   : 'NULL')
                . ' AS ' . $builder->build_identifier_element( $_ ) }
            @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )};
        # Note that the default of NULL thing deals with view's row field that don't have any view_expr or src_field.
        # TODO IF NOT WRONG/OUTDATED: Note that the 'view_field' Nodes we actually need may be in a parent view
        # of the current view; right now we only are looking in the current view.
    }
}

######################################################################

sub build_query_query_expr { # SQL:2003, 7.13 "" (p351)
    my ($builder, $view_node) = @_;
    $builder->_assert_arg_node_type( 'build_query_query_expr',
        'VIEW_NODE', ['view'], $view_node );
    my $view_type = $view_node->get_attribute( 'view_type' );
    my $with_clause = $EMPTY_STR;
    if (!$builder->{$PROP_INLINE_SUBQ}) {
        my @with_list = ();
        my $recursive = 0;
        for my $child_view_node (@{$view_node->get_child_nodes( 'view' )}) {
            if ($child_view_node->get_attribute( 'recursive' )) {
                $recursive = 1;
            }
            my $with_item = $builder->build_identifier_element( $child_view_node );
            if (my @child_arg_nodes = @{$child_view_node->get_child_nodes( 'view_arg' )}) {
                $with_item .= '(' . (join q{, },
                    map { $builder->build_identifier_element( $_ ) }
                    @child_arg_nodes) . ')';
            }
            $with_item .= ' AS (' . $builder->build_query_query_expr( $child_view_node ) . ')';
            push @with_list, $with_item;
        }
        if (@with_list) {
            $with_clause = "\n" . 'WITH ' . ($recursive ? 'RECURSIVE ' : $EMPTY_STR) . (join q{, }, @with_list);
        }
    }
    my $query_expression_body = $builder->build_query_query_expr_body( $view_node );
    return $with_clause . $query_expression_body;
    # TODO: SQL:2003, 7.14 "" (p365).
}

######################################################################

sub build_query_query_expr_body { # SQL:2003, 7.13 "" (p351)
    my ($builder, $view_node) = @_;
    $builder->_assert_arg_node_type( 'build_query_query_expr_body',
        'VIEW_NODE', ['view'], $view_node );
    if ($view_node->get_attribute( 'view_type' ) eq 'COMPOUND') {
        # Result is multiple "SELECT ..." connected by one or more compound operators.
        my $compound_op = $view_node->get_attribute( 'compound_op' );
        my $set_quantifier = $view_node->get_attribute( 'distinct_rows' ) ? 'DISTINCT' : 'ALL';
        my @operand_list = ();
        for my $elem_node (@{$view_node->get_child_nodes( 'view_compound_elem' )}) {
            my $view_src_node = $elem_node->get_attribute( 'operand' );
            my $match_node = $view_src_node->get_attribute( 'match' );
            my $match_name = $builder->build_identifier_schema_or_app_obj( $match_node );
            # Each compounding operand is assumed to have the same row data type as the view.
            if ($match_node->get_node_type() eq 'table') {
                my $row_data_type_node = $builder->_row_data_type_of_node( $match_node );
                push @operand_list, join q{, } . "\n",
                    map { $builder->build_identifier_element( $_ ) }
                    @{$row_data_type_node->get_child_nodes( 'row_data_type_field' )};
            }
            elsif ($match_node->get_node_type() eq 'view') {
                push @operand_list, $builder->build_query_query_expr( $match_node );
            }
            else { # the source node is a local variable of some kind
                push @operand_list, $match_name;
            }
        }
        my $sql_operator
            = $compound_op eq 'UNION'        ? 'UNION'
            : $compound_op eq 'DIFFERENCE'   ? 'EXCEPT'
            : $compound_op eq 'INTERSECTION' ? 'INTERSECT'
            : $compound_op eq 'EXCLUSION'    ? 'EXCLUSION' # this 4th option not in SQL:2003.
            :                                  undef # we should never get here
            ;
            # TODO: try to emulate 'EXCLUSION' somewhere.
        return '(' . (join "\n" . $sql_operator . '_' . $set_quantifier, @operand_list) . ')';
        # TODO: deal with engines that don't like "()" bounding compound operations.
        # TODO: possibly implement .
    }
    else { # view type ne 'COMPOUND'
        # Result is a single "SELECT ...", also known as a single "".
        return $builder->build_query_query_spec( $view_node );
    }
}

######################################################################

sub build_query_subquery { # SQL:2003, 7.15 "" (p370)
    my ($builder, $expr_node) = @_;
    $builder->_assert_arg_node_type( 'build_query_subquery',
        'EXPR_NODE', ['view_expr'], $expr_node );
    my $cview = $expr_node->get_attribute( 'valf_call_view' );
    if ($builder->{$PROP_INLINE_SUBQ}) {
        # Embed an anonymous subquery; argument passing is not yet supported.
        my $query_expression = $builder->build_query_query_expr( $cview );
        return '(' . $query_expression . ')';
    }
    else {
        # Call a named subquery; argument passing is supported.
        my $cview_name = $builder->build_identifier_schema_or_app_obj( $cview );
        my %cview_arg_exprs
            = map { ($_->get_attribute( 'call_view_arg' )->get_self_id() => $_) }
              @{$expr_node->get_child_nodes()}; # gets child view_expr Nodes
        # Note: The build_expr() calls are done below to ensure the arg values are
        # defined in the same order they are output; this lets optional insertion
        # of positionally determined host params (and their mapping) to work right.
        my $arg_val_list = join q{, },
            map { $cview_arg_exprs{$_->get_self_id()}
                  ? $builder->build_expr( $cview_arg_exprs{$_->get_self_id()} )
                  : 'NULL' }
            @{$cview->get_child_nodes( 'view_arg' )};
        return $cview_name . ($arg_val_list ? '(' . $arg_val_list . ')' : $EMPTY_STR);
    }
    # Note: Direct calls to schema object tables or views is not supported outside of 'FROM'.
}

######################################################################

sub build_schema_create { # SQL:2003, 11.1 "" (p519)
    my ($builder, $schema_node) = @_;
    $builder->_assert_arg_node_type( 'build_schema_create',
        'SCHEMA_NODE', ['schema'], $schema_node );
    my $schema_name = $builder->build_identifier_element( $schema_node );
    my $authorization = $EMPTY_STR; # TODO: AUTHORIZATION
    # Some other features in 11.1, such as default character set.
    return 'CREATE SCHEMA ' . $schema_name . ' ' . $authorization . ';' . "\n";
}

sub build_schema_delete { # SQL:2003, 11.2 "" (p522)
    my ($builder, $schema_node) = @_;
    $builder->_assert_arg_node_type( 'build_schema_delete',
        'SCHEMA_NODE', ['schema'], $schema_node );
    my $schema_name = $builder->build_identifier_element( $schema_node );
    return 'DROP SCHEMA ' . $schema_name . ';' . "\n";
}

######################################################################

sub build_schema_or_app_scalar_domain_create { # SQL:2003, 11.24 "" (p603)
    my ($builder, $domain_node) = @_;
    $builder->_assert_arg_node_type( 'build_schema_or_app_scalar_domain_create',
        'DOMAIN_NODE', ['scalar_domain'], $domain_node );
    my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 );
    my $predefined_type = $builder->build_expr_scalar_data_type_defn( $domain_node );
    # TODO: default clause, domain constraint, collate clause.
    my $is_temp = ($domain_node->get_primary_parent_attribute()->get_node_type() eq 'application');
    return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' DOMAIN ' . $domain_name . ' AS ' . $predefined_type . ';' . "\n";
}

sub build_schema_or_app_scalar_domain_delete { # SQL:2003, 11.30 "" (p610)
    my ($builder, $domain_node) = @_;
    $builder->_assert_arg_node_type( 'build_schema_or_app_scalar_domain_delete',
        'DOMAIN_NODE', ['scalar_domain'], $domain_node );
    my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 );
    return 'DROP DOMAIN ' . $domain_name . ';' . "\n";
}

######################################################################

sub build_schema_or_app_row_domain_create { # SQL:2003, 11.24 "" (p603)
    my ($builder, $domain_node) = @_;
    $builder->_assert_arg_node_type( 'build_schema_or_app_row_domain_create',
        'DOMAIN_NODE', ['row_domain'], $domain_node );
    my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 );
    my $predefined_type = $builder->build_expr_row_data_type_defn( $domain_node );
    # TODO: default clause, domain constraint, collate clause.
    my $is_temp = ($domain_node->get_primary_parent_attribute()->get_node_type() eq 'application');
    return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' DOMAIN ' . $domain_name . ' AS ' . $predefined_type . ';' . "\n";
}

sub build_schema_or_app_row_domain_delete { # SQL:2003, 11.30 "" (p610)
    my ($builder, $domain_node) = @_;
    $builder->_assert_arg_node_type( 'build_schema_or_app_row_domain_delete',
        'DOMAIN_NODE', ['row_domain'], $domain_node );
    my $domain_name = $builder->build_identifier_schema_or_app_obj( $domain_node, 1 );
    return 'DROP DOMAIN ' . $domain_name . ';' . "\n";
}

######################################################################

sub build_schema_or_app_sequence_create { # SQL:2003, 11.62 "" (p726)
    my ($builder, $sequence_node) = @_;
    $builder->_assert_arg_node_type( 'build_schema_or_app_sequence_create',
        'SEQUENCE_NODE', ['sequence'], $sequence_node );
    # SQL:2003 allows multiple data types for this, but we stick to integers for now.
    my $sequence_name = $builder->build_identifier_schema_or_app_obj( $sequence_node, 1 );
    my $increment = $sequence_node->get_attribute( 'increment' );
    my $min_val = $sequence_node->get_attribute( 'min_val' );
    my $max_val = $sequence_node->get_attribute( 'max_val' );
    my $start_val = $sequence_node->get_attribute( 'start_val' );
    my $cycle = $sequence_node->get_attribute( 'cycle' );
    my $order = $sequence_node->get_attribute( 'order' );
    # Note that Rosetta::Model guarantees all integer attributes are already valid integers.
    my $is_temp = ($sequence_node->get_primary_parent_attribute()->get_node_type() eq 'application');
    return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' SEQUENCE ' . $sequence_name
        . (defined $increment ? ' INCREMENT BY ' . $increment : $EMPTY_STR)
        . (defined $start_val ? ' START WITH ' . $start_val : $EMPTY_STR)
        . (defined $min_val ? ' MINVALUE ' . $min_val : ' NO MINVALUE')
        . (defined $max_val ? ' MAXVALUE ' . $max_val : ' NO MAXVALUE')
        . ($cycle ? ' CYCLE' : ' NO CYCLE')
        . ($order ? ' ORDER' : ' NO ORDER') # standard doesn't mention this one
        . ';' . "\n";
}

sub build_schema_or_app_sequence_delete { # SQL:2003, 11.64 "" (p729)
    my ($builder, $sequence_node) = @_;
    $builder->_assert_arg_node_type( 'build_schema_or_app_sequence_delete',
        'SEQUENCE_NODE', ['sequence'], $sequence_node );
    my $sequence_name = $builder->build_identifier_schema_or_app_obj( $sequence_node, 1 );
    return 'DROP SEQUENCE ' . $sequence_name . ';' . "\n";
}

######################################################################

sub build_schema_or_app_table_create {
    # SQL:2003, 6.2 "" (p173)
    # SQL:2003, 11.3 "" (p525) 




1773




 





 





 





 





 





 



     # SQL:2003, 11.4 "" (p536) 




1774




 





 





 





 





 





 



     # SQL:2003, 11.5 "" (p541) 




1775




 





 





 





 





 





 



     # SQL:2003, 11.6 "" (p545) 




1776




 





 





 





 





 





 



     # SQL:2003, 11.7 "" (p547) 




1777




 





 





 





 





 





 



     # SQL:2003, 11.8 "" (p549) 




1778




 





 





 





 





 





 



     # TODO: SQL:2003, 11.9 "" (p569) 




1779




 





 





 





 





 





 



     # TODO: "GENERATED ALWAYS AS ..." which looks like FileMaker's (etc) "calculation" field types. 




1780




 





 





 





 





 





 



     my ($builder, $table_node) = @_; 




1781




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_table_create', 




1782




 





 





 





 





 





 



         'TABLE_NODE', ['table'], $table_node ); 




1783




 





 





 





 





 





 



     my $table_name = $builder->build_identifier_schema_or_app_obj( $table_node, 1 ); 




1784




 





 





 





 





 





 



     my @table_field_sql = (); 




1785




 





 





 





 





 





 



     my %col_name_cache = (); # used when making ind defs 




1786




 





 





 





 





 





 



     my %mandatory_field_cache = (); # used when making ind defs 




1787




 





 





 





 





 





 



     my %table_fields_by_row_field = map { ($_->get_attribute( 'si_row_field' )->get_self_id() => $_) } 




1788




 





 





 





 





 





 



         @{$table_node->get_child_nodes( 'table_field' )}; 




1789




 





 





 





 





 





 



     my $row_data_type_node = $builder->_row_data_type_of_node( $table_node ); # is always set 




1790




 





 





 





 





 





 



     my $row_domain_node = $builder->_row_domain_of_node( $table_node ); # may be undefined 




1791




 





 





 





 





 





 



     for my $row_field_node (@{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}) { 




1792




 





 





 





 





 





 



         my $table_field_name = $builder->build_identifier_element( $row_field_node ); 




1793




 





 





 





 





 





 



         if (!exists $col_name_cache{$row_field_node->get_self_id()}) { 




1794




 





 





 





 





 





 



             $col_name_cache{$row_field_node->get_self_id()} = $table_field_name; 




1795




 





 





 





 





 





 



         } 




1796




 





 





 





 





 





 



         my $scalar_data_type_node = $row_field_node->get_attribute( 'scalar_data_type' ); 




1797




 





 





 





 





 





 



         my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( 




1798




 





 





 





 





 





 



             $row_domain_node ? $builder->find_scalar_domain_for_row_domain_field( 




1799




 





 





 





 





 





 



             $scalar_data_type_node, $row_domain_node ) : $scalar_data_type_node ); 




1800




 





 





 





 





 





 



         my $table_field_sql_item = $table_field_name . ' ' . $dt_or_dom_sql; 




1801




 





 





 





 





 





 



         if (my $table_field_node = $table_fields_by_row_field{$row_field_node->get_self_id()}) { 




1802




 





 





 





 





 





 



             my $mandatory = $table_field_node->get_attribute( 'mandatory' ); 




1803




 





 





 





 





 





 



             $mandatory and $mandatory_field_cache{$row_field_node->get_self_id()} = 1; 




1804




 





 





 





 





 





 



             my $default_val = $table_field_node->get_attribute( 'default_val' ); 




1805




 





 





 





 





 





 



             my $auto_inc = $table_field_node->get_attribute( 'auto_inc' ); 




1806




 





 





 





 





 





 



             my $default_seq_node = $table_field_node->get_attribute( 'default_seq' ); 




1807




 





 





 





 





 





 



             $table_field_sql_item .= ($mandatory ? ' NOT NULL' : ' NULL') 




1808




 





 





 





 





 





 



                 . (defined $default_val ? ' DEFAULT ' . $builder->quote_literal( 




1809




 





 





 





 





 





 



                     $default_val, $scalar_data_type_node->get_attribute( 'base_type' ) ) : $EMPTY_STR) 




1810




 





 





 





 





 





 



                 . ($auto_inc ? ' AUTO_INCREMENT' : $EMPTY_STR) 




1811




 





 





 





 





 





 



                 . ($default_seq_node ? ' DEFAULT ' 




1812




 





 





 





 





 





 



                     . $builder->build_expr_seq_next( $default_seq_node ) : $EMPTY_STR); 




1813




 





 





 





 





 





 



         } 




1814




 





 





 





 





 





 



         else { 




1815




 





 





 





 





 





 



             $table_field_sql_item .= ' NULL'; 




1816




 





 





 





 





 





 



         } 




1817




 





 





 





 





 





 



         push @table_field_sql, $table_field_sql_item; 




1818




 





 





 





 





 





 



     } 




1819




 





 





 





 





 





 



     my @table_index_sql = (); 




1820




 





 





 





 





 





 



     my $pk_is_made = 0; 




1821




 





 





 





 





 





 



     for my $table_index_node (@{$table_node->get_child_nodes( 'table_index' )}) { 




1822




 





 





 





 





 





 



         my $table_index_name = $builder->build_identifier_element( $table_index_node ); 




1823




 





 





 





 





 





 



         my $index_type = $table_index_node->get_attribute( 'index_type' ); 




1824




 





 





 





 





 





 



         my @table_index_field_nodes = @{$table_index_node->get_child_nodes( 'table_index_field' )}; 




1825




 





 





 





 





 





 



         my $local_field_names_sql = join q{, }, map { 




1826




 





 





 





 





 





 



                 $col_name_cache{$_->get_attribute( 'si_field' )->get_self_id()} 




1827




 





 





 





 





 





 



             } @table_index_field_nodes; 




1828




 





 





 





 





 





 



         if ($index_type eq 'ATOMIC') { 




1829




 





 





 





 





 





 



             push @table_index_sql, 'INDEX ' . $table_index_name . ' (' . $local_field_names_sql . ')'; 




1830




 





 





 





 





 





 



         } 




1831




 





 





 





 





 





 



         if ($index_type eq 'FULLTEXT') { 




1832




 





 





 





 





 





 



             push @table_index_sql, 'FULLTEXT INDEX ' . $table_index_name . ' (' . $local_field_names_sql . ')'; 




1833




 





 





 





 





 





 



         } 




1834




 





 





 





 





 





 



         if ($index_type eq 'UNIQUE' or $index_type eq 'UFOREIGN') { 




1835




 





 





 





 





 





 



             my $make_a_pk_now = 0; 




1836




 





 





 





 





 





 



             if (!$pk_is_made) { 




1837




 





 





 





 





 





 



                 # All component columns of a primary key must be mandatory; check for it. 




1838




 





 





 





 





 





 



                 $make_a_pk_now = all { 




1839




 





 





 





 





 





 



                         $mandatory_field_cache{ $_->get_attribute( 'si_field' )->get_self_id() } 




1840




 





 





 





 





 





 



                     } @table_index_field_nodes; 




1841




 





 





 





 





 





 



             } 




1842




 





 





 





 





 





 



             if ($make_a_pk_now) { 




1843




 





 





 





 





 





 



                 push @table_index_sql, 'CONSTRAINT PRIMARY KEY (' . $local_field_names_sql . ')'; 




1844




 





 





 





 





 





 



             } 




1845




 





 





 





 





 





 



             else { 




1846




 





 





 





 





 





 



                 push @table_index_sql, 'CONSTRAINT ' . $table_index_name . ' UNIQUE' 




1847




 





 





 





 





 





 



                     . ' (' . $local_field_names_sql . ')'; # standard does not say INDEX after UNIQUE 




1848




 





 





 





 





 





 



             } 




1849




 





 





 





 





 





 



         } 




1850




 





 





 





 





 





 



         if ($index_type eq 'FOREIGN' or $index_type eq 'UFOREIGN') { 




1851




 





 





 





 





 





 



             my $foreign_table_name = $builder->build_identifier_schema_or_app_obj( 




1852




 





 





 





 





 





 



                 $table_index_node->get_attribute( 'f_table' ) ); 




1853




 





 





 





 





 





 



             my $foreign_field_names_sql = join q{, }, map { 




1854




 





 





 





 





 





 



                     $builder->build_identifier_element( $_->get_attribute( 'f_field' ) ) 




1855




 





 





 





 





 





 



                 } @table_index_field_nodes; 




1856




 





 





 





 





 





 



             push @table_index_sql, 'CONSTRAINT ' . $table_index_name . ' FOREIGN KEY' 




1857




 





 





 





 





 





 



                 . ' (' . $local_field_names_sql . ') REFERENCES ' . $foreign_table_name 




1858




 





 





 





 





 





 



                 . ' (' . $foreign_field_names_sql . ')'; 




1859




 





 





 





 





 





 



         } 




1860




 





 





 





 





 





 



     } 




1861




 





 





 





 





 





 



     my $is_temp = ($table_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1862




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' TABLE ' . $table_name 




1863




 





 





 





 





 





 



            . ' (' . "\n" . (join q{, } . "\n", @table_field_sql, @table_index_sql) . "\n" . ');' . "\n"; 




1864




 





 





 





 





 





 



 } 




1865




 





 





 





 





 





 



   




1866




 





 





 





 





 





 



 sub build_schema_or_app_table_delete { # SQL:2003, 11.21 "" (p587) 




1867




 





 





 





 





 





 



     my ($builder, $table_node) = @_; 




1868




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_table_delete', 




1869




 





 





 





 





 





 



         'TABLE_NODE', ['table'], $table_node ); 




1870




 





 





 





 





 





 



     my $table_name = $builder->build_identifier_schema_or_app_obj( $table_node, 1 ); 




1871




 





 





 





 





 





 



     return 'DROP TABLE ' . $table_name . ';' . "\n"; 




1872




 





 





 





 





 





 



 } 




1873




 





 





 





 





 





 



   




1874




 





 





 





 





 





 



 ###################################################################### 




1875




 





 





 





 





 





 



   




1876




 





 





 





 





 





 



 sub build_schema_or_app_view_create { # SQL:2003, 11.22 "" (p590) 




1877




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1878




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_view_create', 




1879




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1880




 





 





 





 





 





 



     my $view_name = $builder->build_identifier_schema_or_app_obj( $view_node, 1 ); 




1881




 





 





 





 





 





 



     my $query_expression = $builder->build_query_query_expr( $view_node ); 




1882




 





 





 





 





 





 



     my $is_temp = ($view_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1883




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' VIEW ' . $view_name . ' AS ' . $query_expression . ';' . "\n"; 




1884




 





 





 





 





 





 



     # Note: Several interesting looking features are not implemented yet. 




1885




 





 





 





 





 





 



 } 




1886




 





 





 





 





 





 



   




1887




 





 





 





 





 





 



 sub build_schema_or_app_view_delete { # SQL:2003, 11.23 "" (p600) 




1888




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1889




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_view_delete', 




1890




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1891




 





 





 





 





 





 



     my $view_name = $builder->build_identifier_schema_or_app_obj( $view_node, 1 ); 




1892




 





 





 





 





 





 



     return 'DROP VIEW ' . $view_name . ';' . "\n"; 




1893




 





 





 





 





 





 



 } 




1894




 





 





 





 





 





 



   




1895




 





 





 





 





 





 



 ###################################################################### 




1896




 





 





 





 





 





 



   




1897




 





 





 





 





 





 



 sub build_schema_or_app_routine_create { 




1898




 





 





 





 





 





 



     # SQL:2003, 11.39 "" (p629) 




1899




 





 





 





 





 





 



     # SQL:2003, 11.50 "" (p675) 




1900




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




1901




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_routine_create', 




1902




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




1903




 





 





 





 





 





 



     my $routine_type = $routine_node->get_attribute( 'routine_type' ); 




1904




 





 





 





 





 





 



     my $routine_name = $builder->build_identifier_schema_or_app_obj( $routine_node, 1 ); 




1905




 





 





 





 





 





 



     my $is_temp = ($routine_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1906




 





 





 





 





 





 



     if ($routine_type eq 'PACKAGE') { 




1907




 





 





 





 





 





 



         # Not implemented yet. 




1908




 





 





 





 





 





 



     } 




1909




 





 





 





 





 





 



     elsif ($routine_type eq 'TRIGGER') { 




1910




 





 





 





 





 





 



         my $table_or_view_name = $builder->build_identifier_schema_or_app_obj( 




1911




 





 





 





 





 





 



             $routine_node->get_attribute( 'trigger_on' ) ); 




1912




 





 





 





 





 





 



         my $trigger_event = $routine_node->get_attribute( 'trigger_event' ); 




1913




 





 





 





 





 





 



         my $trigger_event_sql 




1914




 





 





 





 





 





 



             = $trigger_event eq 'BEFR_INS' ? 'BEFORE INSERT' 




1915




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_INS' ? 'AFTER INSERT' 




1916




 





 





 





 





 





 



             : $trigger_event eq 'INST_INS' ? 'INSTEAD OF INSERT' 




1917




 





 





 





 





 





 



             : $trigger_event eq 'BEFR_UPD' ? 'BEFORE UPDATE' 




1918




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_UPD' ? 'AFTER UPDATE' 




1919




 





 





 





 





 





 



             : $trigger_event eq 'INST_UPD' ? 'INSTEAD OF UPDATE' 




1920




 





 





 





 





 





 



             : $trigger_event eq 'BEFR_DEL' ? 'BEFORE DELETE' 




1921




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_DEL' ? 'AFTER DELETE' 




1922




 





 





 





 





 





 



             : $trigger_event eq 'INST_DEL' ? 'INSTEAD OF DELETE' 




1923




 





 





 





 





 





 



             :                                undef # we should never get here 




1924




 





 





 





 





 





 



             ; 




1925




 





 





 





 





 





 



             # Note: INSTEAD OF is not standard SQL, but supported by SQLServer 2000, maybe Oracle, ?. 




1926




 





 





 





 





 





 



         my $for_each_stmt = $routine_node->get_attribute( 'trigger_per_stmt' ); 




1927




 





 





 





 





 





 



         # TODO: Implement optional OF . 




1928




 





 





 





 





 





 



         my @transition_var_names = (); # TODO: NEW/OLD ROW AS <... variable name> 




1929




 





 





 





 





 





 



         my $triggered_sql_statement = $builder->build_dmanip_routine_body( $routine_node, 1 ); 




1930




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' TRIGGER ' . $routine_name . ' ' 




1931




 





 





 





 





 





 



             . $trigger_event_sql . ' ON ' . $table_or_view_name 




1932




 





 





 





 





 





 



             . (@transition_var_names ? ' REFERENCING ' . (join ' ', @transition_var_names) : $EMPTY_STR) 




1933




 





 





 





 





 





 



             . ($for_each_stmt ? ' FOR EACH STATEMENT' : ' FOR EACH ROW') 




1934




 





 





 





 





 





 



             # TODO: WHEN (  ) 




1935




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1936




 





 





 





 





 





 



             . $triggered_sql_statement 




1937




 





 





 





 





 





 



             . ';' . "\n"; 




1938




 





 





 





 





 





 



     } 




1939




 





 





 





 





 





 



     elsif ($routine_type eq 'PROCEDURE') { 




1940




 





 





 





 





 





 



         my $routine_args = $builder->build_dmanip_routine_args( $routine_node ); 




1941




 





 





 





 





 





 



         # TODO:  where appropriate. 




1942




 





 





 





 





 





 



         my $routine_body = $builder->build_dmanip_routine_body( $routine_node ); 




1943




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' PROCEDURE ' . $routine_name 




1944




 





 





 





 





 





 



             . $routine_args 




1945




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1946




 





 





 





 





 





 



             . ' ' . $routine_body . ';' . "\n"; 




1947




 





 





 





 





 





 



     } 




1948




 





 





 





 





 





 



     elsif ($routine_type eq 'FUNCTION') { 




1949




 





 





 





 





 





 



         my $routine_args = $builder->build_dmanip_routine_args( $routine_node ); 




1950




 





 





 





 





 





 



         # TODO:  where appropriate. 




1951




 





 





 





 





 





 



         my $routine_body = $builder->build_dmanip_routine_body( $routine_node ); 




1952




 





 





 





 





 





 



         my $return_cont_type = $routine_node->get_attribute( 'return_cont_type' ); 




1953




 





 





 





 





 





 



         my $return_data_type = $EMPTY_STR; 




1954




 





 





 





 





 





 



         if ($return_cont_type eq 'ERROR') { 




1955




 





 





 





 





 





 



             # Not implemented yet. 




1956




 





 





 





 





 





 



         } 




1957




 





 





 





 





 





 



         elsif ($return_cont_type eq 'SCALAR') { 




1958




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_scalar_data_type' ); 




1959




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




1960




 





 





 





 





 





 



         } 




1961




 





 





 





 





 





 



         elsif ($return_cont_type eq 'ROW') { 




1962




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_row_data_type' ); 




1963




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




1964




 





 





 





 





 





 



         } 




1965




 





 





 





 





 





 



         elsif ($return_cont_type eq 'SC_ARY') { 




1966




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_scalar_data_type' ); 




1967




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ) . ' ARRAY'; 




1968




 





 





 





 





 





 



         } 




1969




 





 





 





 





 





 



         elsif ($return_cont_type eq 'RW_ARY') { 




1970




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_row_data_type' ); 




1971




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ) . ' ARRAY'; 




1972




 





 





 





 





 





 



         } 




1973




 





 





 





 





 





 



         elsif ($return_cont_type eq 'CONN') { 




1974




 





 





 





 





 





 



             # Not implemented yet. 




1975




 





 





 





 





 





 



         } 




1976




 





 





 





 





 





 



         elsif ($return_cont_type eq 'CURSOR') { 




1977




 





 





 





 





 





 



             # Not implemented yet. 




1978




 





 





 





 





 





 



         } 




1979




 





 





 





 





 





 



         elsif ($return_cont_type eq 'LIST') { 




1980




 





 





 





 





 





 



             # Not implemented yet. 




1981




 





 





 





 





 





 



         } 




1982




 





 





 





 





 





 



         else {} 




1983




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' FUNCTION ' . $routine_name 




1984




 





 





 





 





 





 



             . $routine_args 




1985




 





 





 





 





 





 



             . ' RETURNS ' . $return_data_type 




1986




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1987




 





 





 





 





 





 



             . ' ' . $routine_body . ';' . "\n"; 




1988




 





 





 





 





 





 



     } 




1989




 





 





 





 





 





 



     else {} # $routine_type eq 'BLOCK' 




1990




 





 





 





 





 





 



         # 'BLOCK': no-op; you should call build_dmanip_routine_body() directly instead 




1991




 





 





 





 





 





 



 } 




1992




 





 





 





 





 





 



   




1993




 





 





 





 





 





 



 sub build_schema_or_app_routine_delete { 




1994




 





 





 





 





 





 



     # SQL:2003, 11.40 "" (p633) 




1995




 





 





 





 





 





 



     # SQL:2003, 11.52 "" (p703) 




1996




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




1997




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_routine_delete', 




1998




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




1999




 





 





 





 





 





 



     my $routine_type = $routine_node->get_attribute( 'routine_type' ); 




2000




 





 





 





 





 





 



     my $routine_name = $builder->build_identifier_schema_or_app_obj( $routine_node, 1 ); 




2001




 





 





 





 





 





 



     # Note: 10.6 "" (p499) may be useful later. 




2002




 





 





 





 





 





 



     if ($routine_type eq 'PACKAGE') { 




2003




 





 





 





 





 





 



         # Not implemented yet. 




2004




 





 





 





 





 





 



     } 




2005




 





 





 





 





 





 



     elsif ($routine_type eq 'TRIGGER') { 




2006




 





 





 





 





 





 



         return 'DROP TRIGGER ' . $routine_name . ';' . "\n"; 




2007




 





 





 





 





 





 



     } 




2008




 





 





 





 





 





 



     elsif ($routine_type eq 'PROCEDURE') { 




2009




 





 





 





 





 





 



         return 'DROP PROCEDURE ' . $routine_name . ';' . "\n"; 




2010




 





 





 





 





 





 



     } 




2011




 





 





 





 





 





 



     elsif ($routine_type eq 'FUNCTION') { 




2012




 





 





 





 





 





 



         return 'DROP FUNCTION ' . $routine_name . ';' . "\n"; 




2013




 





 





 





 





 





 



     } 




2014




 





 





 





 





 





 



     else {} # $routine_type eq 'BLOCK'; no-op 




2015




 





 





 





 





 





 



 } 




2016




 





 





 





 





 





 



   




2017




 





 





 





 





 





 



 ###################################################################### 




2018




 





 





 





 





 





 



   




2019




 





 





 





 





 





 



 sub build_access_role_create { # SQL:2003, 12.4 "" (p743) 




2020




 





 





 





 





 





 



     my ($builder, $role_node) = @_; 




2021




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_role_create', 




2022




 





 





 





 





 





 



         'ROLE_NODE', ['role'], $role_node ); 




2023




 





 





 





 





 





 



     my $role_name = $builder->build_identifier_element( $role_node ); 




2024




 





 





 





 





 





 



     return 'CREATE ROLE ' . $role_name . ';' . "\n"; 




2025




 





 





 





 





 





 



 } 




2026




 





 





 





 





 





 



   




2027




 





 





 





 





 





 



 sub build_access_role_delete { # SQL:2003, 12.6 "" (p746) 




2028




 





 





 





 





 





 



     my ($builder, $role_node) = @_; 




2029




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_role_delete', 




2030




 





 





 





 





 





 



         'ROLE_NODE', ['role'], $role_node ); 




2031




 





 





 





 





 





 



     my $role_name = $builder->build_identifier_element( $role_node ); 




2032




 





 





 





 





 





 



     return 'DROP ROLE ' . $role_name . ';' . "\n"; 




2033




 





 





 





 





 





 



 } 




2034




 





 





 





 





 





 



   




2035




 





 





 





 





 





 



 ###################################################################### 




2036




 





 





 





 





 





 



   




2037




 





 





 





 





 





 



 sub build_access_grant { 




2038




 





 





 





 





 





 



     # Function returns empty string if given grantee has no privileges. 




2039




 





 





 





 





 





 



     # SQL:2003, 12.1 "" (p731) 




2040




 





 





 





 





 





 



     # SQL:2003, 12.2 "" (p736) 




2041




 





 





 





 





 





 



     # SQL:2003, 12.3 "" (p739) 




2042




 





 





 





 





 





 



     # SQL:2003, 12.5 "" (p744) 




2043




 





 





 





 





 





 



     my ($builder, $grantee_node) = @_; 




2044




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_grant', 




2045




 





 





 





 





 





 



         'GRANTEE_NODE', ['role','user'], $grantee_node ); 




2046




 





 





 





 





 





 



     my $node_type = $grantee_node->get_node_type(); 




2047




 





 





 





 





 





 



     my $grantee_name = $builder->build_identifier_schema_or_app_obj( $grantee_node ); 




2048




 





 





 





 





 





 



     if ($node_type eq 'role') { 




2049




 





 





 





 





 





 



         my @grant_stmts = (); 




2050




 





 





 





 





 





 



         for my $priv_on_node (@{$grantee_node->get_child_nodes( 'privilege_on' )}) { 




2051




 





 





 





 





 





 



             my $object_node = $priv_on_node->get_attribute( 'si_priv_on' ); 




2052




 





 





 





 





 





 



             my $object_name = $builder->build_identifier_schema_or_app_obj( $object_node ); 




2053




 





 





 





 





 





 



             my @priv_types = map { $_->get_attribute( 'si_priv_type' ) } 




2054




 





 





 





 





 





 



                 @{$priv_on_node->get_child_nodes( 'privilege_for' )}; 




2055




 





 





 





 





 





 



             my @object_privs = (); 




2056




 





 





 





 





 





 



             if (grep { $_ eq 'ALL' } @priv_types) { 




2057




 





 





 





 





 





 



                 push @object_privs, 'ALL PRIVILEGES'; 




2058




 





 





 





 





 





 



             } 




2059




 





 





 





 





 





 



             else { 




2060




 





 





 





 





 





 



                 for my $priv_type (@priv_types) { 




2061




 





 





 





 





 





 



                     push @object_privs, 




2062




 





 





 





 





 





 



                            $priv_type eq 'SELECT' ? 'SELECT' # TODO: allow only specific columns 




2063




 





 





 





 





 





 



                          : $priv_type eq 'DELETE' ? 'DELETE' 




2064




 





 





 





 





 





 



                          : $priv_type eq 'INSERT' ? 'INSERT' # TODO: allow only specific columns 




2065




 





 





 





 





 





 



                          : $priv_type eq 'UPDATE' ? 'UPDATE' # TODO: allow only specific columns 




2066




 





 





 





 





 





 



                          :                          $EMPTY_STR # TODO: REFERENCES, USAGE, TRIGGER, UNDER, EXECUTE; what do they mean? 




2067




 





 





 





 





 





 



                          ; 




2068




 





 





 





 





 





 



                 } 




2069




 





 





 





 





 





 



             } 




2070




 





 





 





 





 





 



             push @grant_stmts, 'GRANT ' . (join q{, }, @object_privs) 




2071




 





 





 





 





 





 



                 . ' ON ' . $object_name . ' TO ' . $grantee_name . ';'; 




2072




 





 





 





 





 





 



         } 




2073




 





 





 





 





 





 



         return join $EMPTY_STR, @grant_stmts; 




2074




 





 





 





 





 





 



     } 




2075




 





 





 





 





 





 



     elsif ($node_type eq 'user') { 




2076




 





 





 





 





 





 



         my @role_names = map { $builder->build_identifier_schema_or_app_obj( $_ ) } 




2077




 





 





 





 





 





 



             @{$grantee_node->get_child_nodes( 'user_role' )}; 




2078




 





 





 





 





 





 



         return @role_names ? 'GRANT ' . (join q{, }, @role_names) . ' TO ' . $grantee_name . ';' : $EMPTY_STR; 




2079




 





 





 





 





 





 



     } 




2080




 





 





 





 





 





 



     else {} 




2081




 





 





 





 





 





 



 } 




2082




 





 





 





 





 





 



   




2083




 





 





 





 





 





 



 sub build_access_revoke { 




2084




 





 





 





 





 





 



     # SQL:2003, 12.7 "" (p747) 




2085




 





 





 





 





 





 



     # SQL:2003, 12.3 "" (p739) 




2086




 





 





 





 





 





 



     my ($builder, $grantee_node) = @_; 




2087




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_revoke', 




2088




 





 





 





 





 





 



         'GRANTEE_NODE', ['role','user'], $grantee_node ); 




2089




 





 





 





 





 





 



     my $node_type = $grantee_node->get_node_type(); 




2090




 





 





 





 





 





 



     my $grantee_name = $builder->build_identifier_schema_or_app_obj( $grantee_node ); 




2091




 





 





 





 





 





 



     if ($node_type eq 'role') { 




2092




 





 





 





 





 





 



         my @revoke_stmts = (); 




2093




 





 





 





 





 





 



         for my $priv_on_node (@{$grantee_node->get_child_nodes( 'privilege_on' )}) { 




2094




 





 





 





 





 





 



             my $object_node = $priv_on_node->get_attribute( 'si_priv_on' ); 




2095




 





 





 





 





 





 



             my $object_name = $builder->build_identifier_schema_or_app_obj( $object_node ); 




2096




 





 





 





 





 





 



             push @revoke_stmts, 'REVOKE ALL PRIVILEGES' 




2097




 





 





 





 





 





 



                 . ' ON ' . $object_name . ' FROM ' . $grantee_name . ';'; 




2098




 





 





 





 





 





 



         } 




2099




 





 





 





 





 





 



         return join $EMPTY_STR, @revoke_stmts; 




2100




 





 





 





 





 





 



     } 




2101




 





 





 





 





 





 



     elsif ($node_type eq 'user') { 




2102




 





 





 





 





 





 



         my @role_names = map { $builder->build_identifier_schema_or_app_obj( $_ ) } 




2103




 





 





 





 





 





 



             @{$grantee_node->get_child_nodes( 'user_role' )}; 




2104




 





 





 





 





 





 



         return @role_names ? 'REVOKE ' . (join q{, }, @role_names) . ' FROM ' . $grantee_name . ';' : $EMPTY_STR; 




2105




 





 





 





 





 





 



     } 




2106




 





 





 





 





 





 



     else {} 




2107




 





 





 





 





 





 



 } 




2108




 





 





 





 





 





 



   




2109




 





 





 





 





 





 



 ###################################################################### 




2110




 





 





 





 





 





 



   




2111




 





 





 





 





 





 



 sub build_dmanip_routine_args { 




2112




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




2113




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_args', 




2114




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




2115




 





 





 





 





 





 



     # SQL:2003, 11.50 "" (p675) 




2116




 





 





 





 





 





 



     # in particular see  




2117




 





 





 





 





 





 



     my @rtn_arg_declare_sql = (); 




2118




 





 





 





 





 





 



     for my $rtn_arg_node (@{$routine_node->get_child_nodes( 'routine_arg' )}) { 




2119




 





 





 





 





 





 



         # TODO:  ::= IN | OUT | INOUT 




2120




 





 





 





 





 





 



         my $arg_name = $builder->build_identifier_element( $rtn_arg_node ); 




2121




 





 





 





 





 





 



         my $cont_type = $rtn_arg_node->get_attribute( 'cont_type' ); 




2122




 





 





 





 





 





 



         if ($cont_type eq 'ERROR') { 




2123




 





 





 





 





 





 



             # Not implemented yet. 




2124




 





 





 





 





 





 



         } 




2125




 





 





 





 





 





 



         elsif ($cont_type eq 'SCALAR') { 




2126




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'scalar_data_type' ); 




2127




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2128




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ';'; 




2129




 





 





 





 





 





 



         } 




2130




 





 





 





 





 





 



         elsif ($cont_type eq 'ROW') { 




2131




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'row_data_type' ); 




2132




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2133




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ';'; 




2134




 





 





 





 





 





 



         } 




2135




 





 





 





 





 





 



         elsif ($cont_type eq 'SC_ARY') { 




2136




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'scalar_data_type' ); 




2137




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2138




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2139




 





 





 





 





 





 



         } 




2140




 





 





 





 





 





 



         elsif ($cont_type eq 'RW_ARY') { 




2141




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'row_data_type' ); 




2142




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2143




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2144




 





 





 





 





 





 



         } 




2145




 





 





 





 





 





 



         elsif ($cont_type eq 'CONN') { 




2146




 





 





 





 





 





 



             # Not implemented yet. 




2147




 





 





 





 





 





 



         } 




2148




 





 





 





 





 





 



         elsif ($cont_type eq 'CURSOR') { 




2149




 





 





 





 





 





 



             # Not implemented yet. 




2150




 





 





 





 





 





 



         } 




2151




 





 





 





 





 





 



         elsif ($cont_type eq 'LIST') { 




2152




 





 





 





 





 





 



             # Not implemented yet. 




2153




 





 





 





 





 





 



         } 




2154




 





 





 





 





 





 



         else {} 




2155




 





 





 





 





 





 



     } 




2156




 





 





 





 





 





 



     return @rtn_arg_declare_sql ? '(' . (join q{, }, @rtn_arg_declare_sql) . ')' : $EMPTY_STR; 




2157




 





 





 





 





 





 



 } 




2158




 





 





 





 





 





 



   




2159




 





 





 





 





 





 



 sub build_dmanip_routine_body { 




2160




 





 





 





 





 





 



     # Corresponds to these sections: 




2161




 





 





 





 





 





 



     # ? 




2162




 





 





 





 





 





 



     # SQL:2003, 6.1 "" (p161) 




2163




 





 





 





 





 





 



     # SQL:2003, 13.5 "" (p790) 




2164




 





 





 





 





 





 



     # SQL:2003, 14.1 "" (p809) 




2165




 





 





 





 





 





 



     my ($builder, $routine_node, $is_atomic) = @_; 




2166




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_body', 




2167




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




2168




 





 





 





 





 





 



     my $is_ora_routines = $builder->{$PROP_ORA_ROUTINES}; 




2169




 





 





 





 





 





 



     my @rtn_var_declare_sql = (); 




2170




 





 





 





 





 





 



     for my $rtn_var_node (@{$routine_node->get_child_nodes( 'routine_var' )}) { 




2171




 





 





 





 





 





 



         my $var_name = $builder->build_identifier_element( $rtn_var_node ); 




2172




 





 





 





 





 





 



         my $cont_type = $rtn_var_node->get_attribute( 'cont_type' ); 




2173




 





 





 





 





 





 



         if ($cont_type eq 'ERROR') { 




2174




 





 





 





 





 





 



             # Not implemented yet. 




2175




 





 





 





 





 





 



         } 




2176




 





 





 





 





 





 



         elsif ($cont_type eq 'SCALAR') { 




2177




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'scalar_data_type' ); 




2178




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2179




 





 





 





 





 





 



             my $init_lit_val = $rtn_var_node->get_attribute( 'init_lit_val' ); 




2180




 





 





 





 





 





 



             my $is_constant = $rtn_var_node->get_attribute( 'is_constant' ); 




2181




 





 





 





 





 





 



             push @rtn_var_declare_sql, 




2182




 





 





 





 





 





 



                 ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') 




2183




 





 





 





 





 





 



                 . $var_name . ' ' . $dt_or_dom_sql 




2184




 





 





 





 





 





 



                 # TODO: use $is_constant 




2185




 





 





 





 





 





 



                 . (defined $init_lit_val ? ' DEFAULT ' . $builder->quote_literal( $init_lit_val, 




2186




 





 





 





 





 





 



                     $builder->_scalar_data_type_of_node( $rtn_var_node )->get_attribute( 'base_type' ) ) : $EMPTY_STR) 




2187




 





 





 





 





 





 



                 . ';' 




2188




 





 





 





 





 





 



             ; 




2189




 





 





 





 





 





 



         } 




2190




 





 





 





 





 





 



         elsif ($cont_type eq 'ROW') { 




2191




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'row_data_type' ); 




2192




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2193




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ';'; 




2194




 





 





 





 





 





 



         } 




2195




 





 





 





 





 





 



         elsif ($cont_type eq 'SC_ARY') { 




2196




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'scalar_data_type' ); 




2197




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2198




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2199




 





 





 





 





 





 



         } 




2200




 





 





 





 





 





 



         elsif ($cont_type eq 'RW_ARY') { 




2201




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'row_data_type' ); 




2202




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2203




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2204




 





 





 





 





 





 



         } 




2205




 





 





 





 





 





 



         elsif ($cont_type eq 'CONN') { 




2206




 





 





 





 





 





 



             # Not implemented yet. 




2207




 





 





 





 





 





 



         } 




2208




 





 





 





 





 





 



         elsif ($cont_type eq 'CURSOR') { 




2209




 





 





 





 





 





 



             if (my $view_node = (@{$rtn_var_node->get_child_nodes( 'view' )})[0]) { 




2210




 





 





 





 





 





 



                 # Since we got here, cursor will be defined within curr rtn, regardless of share or not. 




2211




 





 





 





 





 





 



                 my $query_expr = $builder->build_query_query_expr( $view_node ); 




2212




 





 





 





 





 





 



                 my $order_by_clause = $builder->build_query_window_clause( $view_node ); 




2213




 





 





 





 





 





 



                 my $updatability_clause 




2214




 





 





 





 





 





 



                     = $rtn_var_node->get_attribute( 'curs_for_update' ) ? 'FOR UPDATE' 




2215




 





 





 





 





 





 



                     :                                                     'FOR READ ONLY'; # TODO: [ OF  ] 




2216




 





 





 





 





 





 



                 # TODO: sensitivity, scrollability, holdability, returnability 




2217




 





 





 





 





 





 



                 my $cursor_spec = $query_expr . ' ' . $order_by_clause . ' ' . $updatability_clause; 




2218




 





 





 





 





 





 



                 push @rtn_var_declare_sql, 'DECLARE ' . $var_name . ' CURSOR FOR ' . $cursor_spec . ';'; 




2219




 





 





 





 





 





 



             } 




2220




 





 





 





 





 





 



             else { 




2221




 





 





 





 





 





 



                 # Not implemented yet; but also not sure of proper way to implement. 




2222




 





 





 





 





 





 



                 # If we got here then cursor had been declared in diff rtn and passed to curr one. 




2223




 





 





 





 





 





 



                 # We can't just make another copy of decl since may use vars/args/etc of other rtn. 




2224




 





 





 





 





 





 



                 push @rtn_var_declare_sql, 'DECLARE ' . $var_name . ';'; 




2225




 





 





 





 





 





 



             } 




2226




 





 





 





 





 





 



         } 




2227




 





 





 





 





 





 



         elsif ($cont_type eq 'LIST') { 




2228




 





 





 





 





 





 



             # Not implemented yet. 




2229




 





 





 





 





 





 



         } 




2230




 





 





 





 





 





 



         else {} 




2231




 





 





 





 





 





 



     } 




2232




 





 





 





 





 





 



     my @rtn_stmt_sql = (); 




2233




 





 





 





 





 





 



     for my $rtn_stmt_node (@{$routine_node->get_child_nodes( 'routine_stmt' )}) { 




2234




 





 





 





 





 





 



         push @rtn_stmt_sql, $builder->build_dmanip_routine_stmt( $rtn_stmt_node ); 




2235




 





 





 





 





 





 



     } 




2236




 





 





 





 





 





 



     my $atomic_clause = $is_atomic ? 'ATOMIC ' : $EMPTY_STR; 




2237




 





 





 





 





 





 



     return join ' ', 




2238




 





 





 





 





 





 



         # TODO: proper handling of vars declared within 'BLOCK' routines, when in Oracle syntax. 




2239




 





 





 





 





 





 



         ($is_ora_routines ? 'VAR ' : 'BEGIN ' . $atomic_clause), 




2240




 





 





 





 





 





 



         @rtn_var_declare_sql, 




2241




 





 





 





 





 





 



         ($is_ora_routines ? 'BEGIN ' . $atomic_clause : $EMPTY_STR), 




2242




 





 





 





 





 





 



         @rtn_stmt_sql, 




2243




 





 





 





 





 





 



         'END;' 




2244




 





 





 





 





 





 



     ; 




2245




 





 





 





 





 





 



 } 




2246




 





 





 





 





 





 



   




2247




 





 





 





 





 





 



 ###################################################################### 




2248




 





 





 





 





 





 



   




2249




 





 





 





 





 





 



 sub build_dmanip_routine_stmt { 




2250




 





 





 





 





 





 



     # SQL:2003, 13.5 "" (p790) 




2251




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2252




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_stmt', 




2253




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2254




 





 





 





 





 





 



     if (my $compound_stmt_routine = $rtn_stmt_node->get_attribute( 'block_routine' )) { 




2255




 





 





 





 





 





 



         return $builder->build_dmanip_routine_body( $compound_stmt_routine ); 




2256




 





 





 





 





 





 



     } 




2257




 





 





 





 





 





 



     elsif (my $assign_dest_node = $rtn_stmt_node->get_attribute( 'assign_dest' ) || 




2258




 





 





 





 





 





 



             $rtn_stmt_node->get_attribute( 'assign_dest' )) { 




2259




 





 





 





 





 





 



         my $dest = $builder->build_identifier_element( $assign_dest_node ); 




2260




 





 





 





 





 





 



         my $src = $builder->build_expr( 




2261




 





 





 





 





 





 



             $rtn_stmt_node->get_child_nodes( 'routine_expr' )->[0] ); 




2262




 





 





 





 





 





 



         if ($builder->{$PROP_ORA_ROUTINES}) { 




2263




 





 





 





 





 





 



             return $dest . ' := ' . $src . ';' . "\n"; 




2264




 





 





 





 





 





 



         } 




2265




 





 





 





 





 





 



         else { 




2266




 





 





 





 





 





 



             return 'SET ' . $dest . ' = ' . $src . ';' . "\n"; 




2267




 





 





 





 





 





 



         } 




2268




 





 





 





 





 





 



     } 




2269




 





 





 





 





 





 



     elsif ($rtn_stmt_node->get_attribute( 'call_sroutine' )) { 




2270




 





 





 





 





 





 



         return $builder->build_dmanip_call_sroutine( $rtn_stmt_node ); 




2271




 





 





 





 





 





 



     } 




2272




 





 





 





 





 





 



     elsif ($rtn_stmt_node->get_attribute( 'call_uroutine' )) { 




2273




 





 





 





 





 





 



         return $builder->build_dmanip_call_uroutine( $rtn_stmt_node ); 




2274




 





 





 





 





 





 



     } 




2275




 





 





 





 





 





 



     else {} 




2276




 





 





 





 





 





 



 } 




2277




 





 





 





 





 





 



   




2278




 





 





 





 





 





 



 ###################################################################### 




2279




 





 





 





 





 





 



   




2280




 





 





 





 





 





 



 sub build_dmanip_call_sroutine { 




2281




 





 





 





 





 





 



     # Corresponds to these sections: 




2282




 





 





 





 





 





 



     # SQL:2003, 14.2 "" (p815) 




2283




 





 





 





 





 





 



     # SQL:2003, 14.3 "" (p817) 




2284




 





 





 





 





 





 



     # SQL:2003, 14.4 "" (p822) 




2285




 





 





 





 





 





 



     # SQL:2003, 15.2 "" (p886) 




2286




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2287




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_call_sroutine', 




2288




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2289




 





 





 





 





 





 



     my $sroutine = $rtn_stmt_node->get_attribute( 'call_sroutine' ); 




2290




 





 





 





 





 





 



     my %child_exprs = map { ( 




2291




 





 





 





 





 





 



             ($_->get_attribute( 'call_sroutine_cxt' ) || 




2292




 





 





 





 





 





 



                 $_->get_attribute( 'call_sroutine_arg' )) => $_ 




2293




 





 





 





 





 





 



         ) } @{$rtn_stmt_node->get_child_nodes( 'routine_expr' )}; 




2294




 





 





 





 





 





 



     if ($sroutine eq 'RETURN') { 




2295




 





 





 





 





 





 



         my $return_value = $builder->build_expr( $child_exprs{'RETURN_VALUE'} ); 




2296




 





 





 





 





 





 



         return 'RETURN ' . $return_value . ';' . "\n"; # no parens in standard 




2297




 





 





 





 





 





 



     } 




2298




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_OPEN') { # opens a select cursor for reading from (or performs a select if in right context) 




2299




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2300




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2301




 





 





 





 





 





 



         return 'OPEN ' . $cursor_cx_name . ';' . "\n"; 




2302




 





 





 





 





 





 



     } 




2303




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_CLOSE') { # closes a select cursor when you're done with it 




2304




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2305




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2306




 





 





 





 





 





 



         return 'CLOSE ' . $cursor_cx_name . ';' . "\n"; 




2307




 





 





 





 





 





 



     } 




2308




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_FETCH') { # reads a row from an opened cursor and puts it in a row/list variable 




2309




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2310




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2311




 





 





 





 





 





 



         my $fetch_orient = $EMPTY_STR; # TODO: the explicit  options; NEXT is default 




2312




 





 





 





 





 





 



         my $query_dest_name = $builder->build_identifier_element( 




2313




 





 





 





 





 





 



             $child_exprs{'INTO'}->get_attribute( 'query_dest' ) ); 




2314




 





 





 





 





 





 



         return 'FETCH ' . $fetch_orient . ' FROM ' . $cursor_cx_name . ' INTO ' . $query_dest_name . ';' . "\n"; 




2315




 





 





 





 





 





 



     } 




2316




 





 





 





 





 





 



     elsif ($sroutine eq 'SELECT') { # fetches one row from a table/view and puts it in a row/list variable 




2317




 





 





 





 





 





 



         my $view_node = $child_exprs{'SELECT_DEFN'}->get_attribute( 'act_on' ); 




2318




 





 





 





 





 





 



         return $builder->build_query_query_spec( $view_node, 




2319




 





 





 





 





 





 



             $child_exprs{'INTO'}->get_attribute( 'query_dest' ) ) . ';' . "\n"; 




2320




 





 





 





 





 





 



     } 




2321




 





 





 





 





 





 



     elsif ($sroutine eq 'INSERT') { # inserts a row into a table/view 




2322




 





 





 





 





 





 



         my $view_node = $child_exprs{'INSERT_DEFN'}->get_attribute( 'act_on' ); 




2323




 





 





 





 





 





 



         return $builder->build_dmanip_insert_stmt( $view_node ); 




2324




 





 





 





 





 





 



     } 




2325




 





 





 





 





 





 



     elsif ($sroutine eq 'UPDATE') { # updates a row in a table/view 




2326




 





 





 





 





 





 



         my $view_node = $child_exprs{'UPDATE_DEFN'}->get_attribute( 'act_on' ); 




2327




 





 





 





 





 





 



         return $builder->build_dmanip_update_stmt( $view_node ); 




2328




 





 





 





 





 





 



     } 




2329




 





 





 





 





 





 



     elsif ($sroutine eq 'DELETE') { # deletes a row in a table/view 




2330




 





 





 





 





 





 



         my $view_node = $child_exprs{'DELETE_DEFN'}->get_attribute( 'act_on' ); 




2331




 





 





 





 





 





 



         return $builder->build_dmanip_delete_stmt( $view_node ); 




2332




 





 





 





 





 





 



     } 




2333




 





 





 





 





 





 



     elsif ($sroutine eq 'COMMIT') { # commits the current transaction, then starts a new one 




2334




 





 





 





 





 





 



         return 'COMMIT; START TRANSACTION;' . "\n"; 




2335




 





 





 





 





 





 



         # Note: According to the MySQL manual: 




2336




 





 





 





 





 





 



         # For transaction-safe tables, there are actions (other than typing COMMIT) 




2337




 





 





 





 





 





 



         # that will automatically trigger a COMMIT. Requesting a lock will implicitly 




2338




 





 





 





 





 





 



         # commit any outstanding queries. 




2339




 





 





 





 





 





 



     } 




2340




 





 





 





 





 





 



     elsif ($sroutine eq 'ROLLBACK') { # rolls back the current transaction, then starts a new one 




2341




 





 





 





 





 





 



         return 'ROLLBACK; START TRANSACTION;' . "\n"; # TODO: rollback to a named save point only 




2342




 





 





 





 





 





 



     } 




2343




 





 





 





 





 





 



     else {} # There are a bunch more that aren't implemented yet. 




2344




 





 





 





 





 





 



 } 




2345




 





 





 





 





 





 



   




2346




 





 





 





 





 





 



 ###################################################################### 




2347




 





 





 





 





 





 



   




2348




 





 





 





 





 





 



 sub build_dmanip_src_schema_object_name { 




2349




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2350




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_src_schema_object_name', 




2351




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2352




 





 





 





 





 





 



     my $view_type = $view_node->get_attribute( 'view_type' ); 




2353




 





 





 





 





 





 



     my @view_src_nodes = @{$view_node->get_child_nodes( 'view_src' )}; 




2354




 





 





 





 





 





 



     if (@view_src_nodes == 0) { 




2355




 





 





 





 





 





 



         return; # No source at all. 




2356




 





 





 





 





 





 



     } 




2357




 





 





 





 





 





 



     elsif ($view_type eq 'ALIAS' or @view_src_nodes == 1) { 




2358




 





 





 





 





 





 



         my $object_node = $view_src_nodes[0]->get_attribute( 'match' ); 




2359




 





 





 





 





 





 



         if ($object_node->get_primary_parent_attribute()->get_node_type() eq 'schema') { 




2360




 





 





 





 





 





 



             # The only source is a schema object, table or named view; use it directly. 




2361




 





 





 





 





 





 



             return $builder->build_identifier_schema_or_app_obj( $object_node ); 




2362




 





 





 





 





 





 



         } 




2363




 





 





 





 





 





 



         else { 




2364




 





 





 





 





 





 



             # The only source seems to be a sub-query in "from". 




2365




 





 





 





 





 





 



             return; # Adding recursion in all necessary places too complicated for now. 




2366




 





 





 





 





 





 



         } 




2367




 





 





 





 





 





 



     } 




2368




 





 





 





 





 





 



     else { # @view_src_nodes >= 2 




2369




 





 





 





 





 





 



         return; # Manual updates against multiple sources too complicated for now. 




2370




 





 





 





 





 





 



     } 




2371




 





 





 





 





 





 



 } 




2372




 





 





 





 





 





 



   




2373




 





 





 





 





 





 



 ###################################################################### 




2374




 





 





 





 





 





 



   




2375




 





 





 





 





 





 



 sub build_dmanip_insert_stmt { 




2376




 





 





 





 





 





 



     # SQL:2003, 7.3 "" (p298) 




2377




 





 





 





 





 





 



     # SQL:2003, 14.8 "" (p834) 




2378




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2379




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_insert_stmt', 




2380




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2381




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2382




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2383




 





 





 





 





 





 



     my @set_expr_nodes 




2384




 





 





 





 





 





 



         = grep { $_->get_attribute( 'view_part' ) eq 'SET' } 




2385




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




2386




 





 





 





 





 





 



     my @set_fields_list = (); 




2387




 





 





 





 





 





 



     my @set_values_list = (); 




2388




 





 





 





 





 





 



     for my $expr_node (@set_expr_nodes) { 




2389




 





 





 





 





 





 



         push @set_fields_list, $builder->build_identifier_element( 




2390




 





 





 





 





 





 



             $expr_node->get_attribute( 'set_src_field' ) ); 




2391




 





 





 





 





 





 



         push @set_values_list, $builder->build_expr( $expr_node ); 




2392




 





 





 





 





 





 



     } 




2393




 





 





 





 





 





 



     my $insert_fields_and_src = '(' . (join q{, }, @set_fields_list) . ') ' 




2394




 





 





 





 





 





 



         . 'VALUES (' . (join q{, }, @set_values_list) . ')'; 




2395




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2396




 





 





 





 





 





 



     return 'INSERT INTO ' . $object_name . ' ' . $insert_fields_and_src . ';' . "\n"; 




2397




 





 





 





 





 





 



 } 




2398




 





 





 





 





 





 



   




2399




 





 





 





 





 





 



 ###################################################################### 




2400




 





 





 





 





 





 



   




2401




 





 





 





 





 





 



 sub build_dmanip_update_stmt { 




2402




 





 





 





 





 





 



     # SQL:2003, 14.11 "" (p849) 




2403




 





 





 





 





 





 



     # SQL:2003, 14.12 "" (p853) 




2404




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2405




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_update_stmt', 




2406




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2407




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2408




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2409




 





 





 





 





 





 



     my @set_expr_nodes 




2410




 





 





 





 





 





 



         = grep { $_->get_attribute( 'view_part' ) eq 'SET' } 




2411




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




2412




 





 





 





 





 





 



     my @set_clause_list = (); 




2413




 





 





 





 





 





 



     for my $expr_node (@set_expr_nodes) { 




2414




 





 





 





 





 





 



         my $set_target = $builder->build_identifier_element( 




2415




 





 





 





 





 





 



             $expr_node->get_attribute( 'set_src_field' ) ); 




2416




 





 





 





 





 





 



         my $update_source = $builder->build_expr( $expr_node ); 




2417




 





 





 





 





 





 



         push @set_clause_list, $set_target . ' = ' . $update_source; 




2418




 





 





 





 





 





 



     } 




2419




 





 





 





 





 





 



     my $set_clause = 'SET ' . (join q{, }, @set_clause_list); 




2420




 





 





 





 





 





 



     my $where_clause = $builder->build_query_where_clause( $view_node ); 




2421




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2422




 





 





 





 





 





 



     return 'UPDATE ' . $object_name . ' ' . $set_clause . ' ' . $where_clause . ';' . "\n"; 




2423




 





 





 





 





 





 



 } 




2424




 





 





 





 





 





 



   




2425




 





 





 





 





 





 



 ###################################################################### 




2426




 





 





 





 





 





 



   




2427




 





 





 





 





 





 



 sub build_dmanip_delete_stmt { # SQL:2003, 14.7 "" (p831) 




2428




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2429




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_delete_stmt', 




2430




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2431




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2432




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2433




 





 





 





 





 





 



     my $where_clause = $builder->build_query_where_clause( $view_node ); 




2434




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2435




 





 





 





 





 





 



     return 'DELETE FROM ' . $object_name . ' ' . $where_clause . ';' . "\n"; 




2436




 





 





 





 





 





 



 } 




2437




 





 





 





 





 





 



   




2438




 





 





 





 





 





 



 ###################################################################### 




2439




 





 





 





 





 





 



   




2440




 





 





 





 





 





 



 sub build_dmanip_call_uroutine { 




2441




 





 





 





 





 





 



     # SQL:2003 ...  ... 




2442




 





 





 





 





 





 



     # SQL:2003, 15.1 "" (p885) 




2443




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2444




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_call_uroutine', 




2445




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2446




 





 





 





 





 





 



     my $uroutine = $rtn_stmt_node->get_attribute( 'call_uroutine' ); 




2447




 





 





 





 





 





 



     my $uroutine_name = $builder->build_identifier_schema_or_app_obj( $uroutine ); 




2448




 





 





 





 





 





 



     my %uroutine_arg_exprs 




2449




 





 





 





 





 





 



         = map { ($_->get_attribute( 'call_uroutine_arg' )->get_self_id() => $_) } 




2450




 





 





 





 





 





 



           @{$rtn_stmt_node->get_child_nodes( 'routine_expr' )}; 




2451




 





 





 





 





 





 



     # Note: The build_expr() calls are done below to ensure the arg values are 




2452




 





 





 





 





 





 



     # defined in the same order they are output; this lets optional insertion 




2453




 





 





 





 





 





 



     # of positionally determined host params (and their mapping) to work right. 




2454




 





 





 





 





 





 



     my $arg_val_list = join q{, }, 




2455




 





 





 





 





 





 



         map { $uroutine_arg_exprs{$_->get_self_id()} 




2456




 





 





 





 





 





 



               ? $builder->build_expr( $uroutine_arg_exprs{$_->get_self_id()} ) 




2457




 





 





 





 





 





 



               : 'NULL' } 




2458




 





 





 





 





 





 



         @{$uroutine->get_child_nodes( 'routine_arg' )}; 




2459




 





 





 





 





 





 



     #  ::= CALL  




2460




 





 





 





 





 





 



     return 'CALL ' . $uroutine_name . ($arg_val_list ? '(' . $arg_val_list . ')' : $EMPTY_STR) . ';' . "\n"; 




2461




 





 





 





 





 





 



 } 




2462




 





 





 





 





 





 



   




2463




 





 





 





 





 





 



 ###################################################################### 




2464




 





 





 





 





 





 



   




2465




 





 





 





 





 





 



 sub substitute_macros { 




2466




 





 





 





 





 





 



     my ($builder, $str, $subs) = @_; 




2467




 





 





 





 





 





 



     while (my ($key,$value) = each %{$subs}) { 




2468




 





 





 





 





 





 



         $str =~ s/ \{ $key \} /$value/x; 




2469




 





 





 





 





 





 



     } 




2470




 





 





 





 





 





 



     return $str; 




2471




 





 





 





 





 





 



 } 




2472




 





 





 





 





 





 



   




2473




 





 





 





 





 





 



 ###################################################################### 




2474




 





 





 





 





 





 



   




2475




 





 





 





 





 





 



 sub find_scalar_domain_for_row_domain_field { 




2476




 





 





 





 





 





 



     my ($builder, $scalar_data_type_node, $row_domain_node) = @_; 




2477




 





 





 





 





 





 



     my @candidates = grep { $_->get_attribute( 'data_type' )->get_self_id() eq $scalar_data_type_node->get_self_id() } 




2478




 





 





 





 





 





 



         @{$row_domain_node->get_primary_parent_attribute()->get_child_nodes( 'scalar_domain' )}; 




2479




 





 





 





 





 





 



     return $candidates[0] || $scalar_data_type_node; 




2480




 





 





 





 





 





 



 } 




2481




 





 





 





 





 





 



   




2482




 





 





 





 





 





 



 ###################################################################### 




2483




 





 





 





 





 





 



   




2484




 





 





 





 





 





 



 sub _scalar_data_type_of_node { 




2485




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2486




 





 





 





 





 





 



     $atnm ||= 'scalar_data_type'; 




2487




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2488




 





 





 





 





 





 



     if ($dt_or_dom_node->get_node_type() eq 'scalar_domain') { 




2489




 





 





 





 





 





 



         $dt_or_dom_node = $dt_or_dom_node->get_attribute( 'data_type' ); 




2490




 





 





 





 





 





 



     } 




2491




 





 





 





 





 





 



     return $dt_or_dom_node; 




2492




 





 





 





 





 





 



 } 




2493




 





 





 





 





 





 



   




2494




 





 





 





 





 





 



 sub _row_data_type_of_node { 




2495




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2496




 





 





 





 





 





 



     $atnm ||= 'row_data_type'; 




2497




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2498




 





 





 





 





 





 



     if ($dt_or_dom_node->get_node_type() eq 'row_domain') { 




2499




 





 





 





 





 





 



         $dt_or_dom_node = $dt_or_dom_node->get_attribute( 'data_type' ); 




2500




 





 





 





 





 





 



     } 




2501




 





 





 





 





 





 



     return $dt_or_dom_node; 




2502




 





 





 





 





 





 



 } 




2503




 





 





 





 





 





 



   




2504




 





 





 





 





 





 



 sub _row_domain_of_node { 




2505




 





 





 





 





 





 



     # returns domain or nothing 




2506




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2507




 





 





 





 





 





 



     $atnm ||= 'row_data_type'; 




2508




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2509




 





 





 





 





 





 



     return $dt_or_dom_node 




2510




 





 





 





 





 





 



         if $dt_or_dom_node->get_node_type() eq 'row_domain'; 




2511




 





 





 





 





 





 



     return; 




2512




 





 





 





 





 





 



 } 




2513




 





 





 





 





 





 



   




2514




 





 





 





 





 





 



 ###################################################################### 




2515




 





 





 





 





 





 



 # This is a 'protected' method; only sub-classes should invoke it. 




2516




 





 





 





 





 





 



   




2517




 





 





 





 





 





 



 sub _throw_error_message { 




2518




 





 





 





 





 





 



     my ($builder, $msg_key, $msg_vars) = @_; 




2519




 





 





 





 





 





 



     # Throws an exception consisting of an object. 




2520




 





 





 





 





 





 



     ref $msg_vars eq 'HASH' or $msg_vars = {}; 




2521




 





 





 





 





 





 



     for my $var_key (keys %{$msg_vars}) { 




2522




 





 





 





 





 





 



         if (ref $msg_vars->{$var_key} eq 'ARRAY') { 




2523




 





 





 





 





 





 



             $msg_vars->{$var_key} = 'PERL_ARRAY:[' . (join q{,},map {$_||$EMPTY_STR} @{$msg_vars->{$var_key}}) . ']'; 




2524




 





 





 





 





 





 



         } 




2525




 





 





 





 





 





 



     } 




2526




 





 





 





 





 





 



     die Locale::KeyedText->new_message( $msg_key, $msg_vars ); 




2527




 





 





 





 





 





 



 } 




2528




 





 





 





 





 





 



   




2529




 





 





 





 





 





 



 sub _assert_arg_node_type { 




2530




 





 





 





 





 





 



     my ($builder, $meth_name, $arg_name, $exp_node_types, $arg_value) = @_; 




2531




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_UNDEF', 




2532




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name } ) 




2533




 





 





 





 





 





 



         if !defined $arg_value; 




2534




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_NO_NODE', 




2535




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name, 'ARGVL' => $arg_value } ) 




2536




 





 





 





 





 





 



         if !ref $arg_value or !UNIVERSAL::isa( $arg_value, 'Rosetta::Model::Node' ); 




2537




 





 





 





 





 





 



     return 




2538




 





 





 





 





 





 



         if @{$exp_node_types} == 0; # any Node type is acceptable 




2539




 





 





 





 





 





 



     my $given_node_type = $arg_value->get_node_type(); 




2540




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_WRONG_NODE_TYPE', 




2541




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name, 




2542




 





 





 





 





 





 



         'EXPNTYPE' => $exp_node_types, 'ARGNTYPE' => $given_node_type } ) 




2543




 





 





 





 





 





 



         if !grep { $given_node_type eq $_ } @{$exp_node_types}; 




2544




 





 





 





 





 





 



     # If we get here, $arg_value is acceptable to the method. 




2545




 





 





 





 





 





 



 } 




2546




 





 





 





 





 





 



   




2547




 





 





 





 





 





 



 ###################################################################### 




2548




 





 





 





 





 





 



 ###################################################################### 




2549




 





 





 





 





 





 



   




2550




 





 





 





 





 





 



 1; 




2551




 





 





 





 





 





 



 __END__
    # SQL:2003, 11.4 "" (p536)
    # SQL:2003, 11.5 "" (p541)
    # SQL:2003, 11.6 "" (p545) 




1776




 





 





 





 





 





 



     # SQL:2003, 11.7 "" (p547) 




1777




 





 





 





 





 





 



     # SQL:2003, 11.8 "" (p549) 




1778




 





 





 





 





 





 



     # TODO: SQL:2003, 11.9 "" (p569) 




1779




 





 





 





 





 





 



     # TODO: "GENERATED ALWAYS AS ..." which looks like FileMaker's (etc) "calculation" field types. 




1780




 





 





 





 





 





 



     my ($builder, $table_node) = @_; 




1781




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_table_create', 




1782




 





 





 





 





 





 



         'TABLE_NODE', ['table'], $table_node ); 




1783




 





 





 





 





 





 



     my $table_name = $builder->build_identifier_schema_or_app_obj( $table_node, 1 ); 




1784




 





 





 





 





 





 



     my @table_field_sql = (); 




1785




 





 





 





 





 





 



     my %col_name_cache = (); # used when making ind defs 




1786




 





 





 





 





 





 



     my %mandatory_field_cache = (); # used when making ind defs 




1787




 





 





 





 





 





 



     my %table_fields_by_row_field = map { ($_->get_attribute( 'si_row_field' )->get_self_id() => $_) } 




1788




 





 





 





 





 





 



         @{$table_node->get_child_nodes( 'table_field' )}; 




1789




 





 





 





 





 





 



     my $row_data_type_node = $builder->_row_data_type_of_node( $table_node ); # is always set 




1790




 





 





 





 





 





 



     my $row_domain_node = $builder->_row_domain_of_node( $table_node ); # may be undefined 




1791




 





 





 





 





 





 



     for my $row_field_node (@{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}) { 




1792




 





 





 





 





 





 



         my $table_field_name = $builder->build_identifier_element( $row_field_node ); 




1793




 





 





 





 





 





 



         if (!exists $col_name_cache{$row_field_node->get_self_id()}) { 




1794




 





 





 





 





 





 



             $col_name_cache{$row_field_node->get_self_id()} = $table_field_name; 




1795




 





 





 





 





 





 



         } 




1796




 





 





 





 





 





 



         my $scalar_data_type_node = $row_field_node->get_attribute( 'scalar_data_type' ); 




1797




 





 





 





 





 





 



         my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( 




1798




 





 





 





 





 





 



             $row_domain_node ? $builder->find_scalar_domain_for_row_domain_field( 




1799




 





 





 





 





 





 



             $scalar_data_type_node, $row_domain_node ) : $scalar_data_type_node ); 




1800




 





 





 





 





 





 



         my $table_field_sql_item = $table_field_name . ' ' . $dt_or_dom_sql; 




1801




 





 





 





 





 





 



         if (my $table_field_node = $table_fields_by_row_field{$row_field_node->get_self_id()}) { 




1802




 





 





 





 





 





 



             my $mandatory = $table_field_node->get_attribute( 'mandatory' ); 




1803




 





 





 





 





 





 



             $mandatory and $mandatory_field_cache{$row_field_node->get_self_id()} = 1; 




1804




 





 





 





 





 





 



             my $default_val = $table_field_node->get_attribute( 'default_val' ); 




1805




 





 





 





 





 





 



             my $auto_inc = $table_field_node->get_attribute( 'auto_inc' ); 




1806




 





 





 





 





 





 



             my $default_seq_node = $table_field_node->get_attribute( 'default_seq' ); 




1807




 





 





 





 





 





 



             $table_field_sql_item .= ($mandatory ? ' NOT NULL' : ' NULL') 




1808




 





 





 





 





 





 



                 . (defined $default_val ? ' DEFAULT ' . $builder->quote_literal( 




1809




 





 





 





 





 





 



                     $default_val, $scalar_data_type_node->get_attribute( 'base_type' ) ) : $EMPTY_STR) 




1810




 





 





 





 





 





 



                 . ($auto_inc ? ' AUTO_INCREMENT' : $EMPTY_STR) 




1811




 





 





 





 





 





 



                 . ($default_seq_node ? ' DEFAULT ' 




1812




 





 





 





 





 





 



                     . $builder->build_expr_seq_next( $default_seq_node ) : $EMPTY_STR); 




1813




 





 





 





 





 





 



         } 




1814




 





 





 





 





 





 



         else { 




1815




 





 





 





 





 





 



             $table_field_sql_item .= ' NULL'; 




1816




 





 





 





 





 





 



         } 




1817




 





 





 





 





 





 



         push @table_field_sql, $table_field_sql_item; 




1818




 





 





 





 





 





 



     } 




1819




 





 





 





 





 





 



     my @table_index_sql = (); 




1820




 





 





 





 





 





 



     my $pk_is_made = 0; 




1821




 





 





 





 





 





 



     for my $table_index_node (@{$table_node->get_child_nodes( 'table_index' )}) { 




1822




 





 





 





 





 





 



         my $table_index_name = $builder->build_identifier_element( $table_index_node ); 




1823




 





 





 





 





 





 



         my $index_type = $table_index_node->get_attribute( 'index_type' ); 




1824




 





 





 





 





 





 



         my @table_index_field_nodes = @{$table_index_node->get_child_nodes( 'table_index_field' )}; 




1825




 





 





 





 





 





 



         my $local_field_names_sql = join q{, }, map { 




1826




 





 





 





 





 





 



                 $col_name_cache{$_->get_attribute( 'si_field' )->get_self_id()} 




1827




 





 





 





 





 





 



             } @table_index_field_nodes; 




1828




 





 





 





 





 





 



         if ($index_type eq 'ATOMIC') { 




1829




 





 





 





 





 





 



             push @table_index_sql, 'INDEX ' . $table_index_name . ' (' . $local_field_names_sql . ')'; 




1830




 





 





 





 





 





 



         } 




1831




 





 





 





 





 





 



         if ($index_type eq 'FULLTEXT') { 




1832




 





 





 





 





 





 



             push @table_index_sql, 'FULLTEXT INDEX ' . $table_index_name . ' (' . $local_field_names_sql . ')'; 




1833




 





 





 





 





 





 



         } 




1834




 





 





 





 





 





 



         if ($index_type eq 'UNIQUE' or $index_type eq 'UFOREIGN') { 




1835




 





 





 





 





 





 



             my $make_a_pk_now = 0; 




1836




 





 





 





 





 





 



             if (!$pk_is_made) { 




1837




 





 





 





 





 





 



                 # All component columns of a primary key must be mandatory; check for it. 




1838




 





 





 





 





 





 



                 $make_a_pk_now = all { 




1839




 





 





 





 





 





 



                         $mandatory_field_cache{ $_->get_attribute( 'si_field' )->get_self_id() } 




1840




 





 





 





 





 





 



                     } @table_index_field_nodes; 




1841




 





 





 





 





 





 



             } 




1842




 





 





 





 





 





 



             if ($make_a_pk_now) { 




1843




 





 





 





 





 





 



                 push @table_index_sql, 'CONSTRAINT PRIMARY KEY (' . $local_field_names_sql . ')'; 




1844




 





 





 





 





 





 



             } 




1845




 





 





 





 





 





 



             else { 




1846




 





 





 





 





 





 



                 push @table_index_sql, 'CONSTRAINT ' . $table_index_name . ' UNIQUE' 




1847




 





 





 





 





 





 



                     . ' (' . $local_field_names_sql . ')'; # standard does not say INDEX after UNIQUE 




1848




 





 





 





 





 





 



             } 




1849




 





 





 





 





 





 



         } 




1850




 





 





 





 





 





 



         if ($index_type eq 'FOREIGN' or $index_type eq 'UFOREIGN') { 




1851




 





 





 





 





 





 



             my $foreign_table_name = $builder->build_identifier_schema_or_app_obj( 




1852




 





 





 





 





 





 



                 $table_index_node->get_attribute( 'f_table' ) ); 




1853




 





 





 





 





 





 



             my $foreign_field_names_sql = join q{, }, map { 




1854




 





 





 





 





 





 



                     $builder->build_identifier_element( $_->get_attribute( 'f_field' ) ) 




1855




 





 





 





 





 





 



                 } @table_index_field_nodes; 




1856




 





 





 





 





 





 



             push @table_index_sql, 'CONSTRAINT ' . $table_index_name . ' FOREIGN KEY' 




1857




 





 





 





 





 





 



                 . ' (' . $local_field_names_sql . ') REFERENCES ' . $foreign_table_name 




1858




 





 





 





 





 





 



                 . ' (' . $foreign_field_names_sql . ')'; 




1859




 





 





 





 





 





 



         } 




1860




 





 





 





 





 





 



     } 




1861




 





 





 





 





 





 



     my $is_temp = ($table_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1862




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' TABLE ' . $table_name 




1863




 





 





 





 





 





 



            . ' (' . "\n" . (join q{, } . "\n", @table_field_sql, @table_index_sql) . "\n" . ');' . "\n"; 




1864




 





 





 





 





 





 



 } 




1865




 





 





 





 





 





 



   




1866




 





 





 





 





 





 



 sub build_schema_or_app_table_delete { # SQL:2003, 11.21 "" (p587) 




1867




 





 





 





 





 





 



     my ($builder, $table_node) = @_; 




1868




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_table_delete', 




1869




 





 





 





 





 





 



         'TABLE_NODE', ['table'], $table_node ); 




1870




 





 





 





 





 





 



     my $table_name = $builder->build_identifier_schema_or_app_obj( $table_node, 1 ); 




1871




 





 





 





 





 





 



     return 'DROP TABLE ' . $table_name . ';' . "\n"; 




1872




 





 





 





 





 





 



 } 




1873




 





 





 





 





 





 



   




1874




 





 





 





 





 





 



 ###################################################################### 




1875




 





 





 





 





 





 



   




1876




 





 





 





 





 





 



 sub build_schema_or_app_view_create { # SQL:2003, 11.22 "" (p590) 




1877




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1878




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_view_create', 




1879




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1880




 





 





 





 





 





 



     my $view_name = $builder->build_identifier_schema_or_app_obj( $view_node, 1 ); 




1881




 





 





 





 





 





 



     my $query_expression = $builder->build_query_query_expr( $view_node ); 




1882




 





 





 





 





 





 



     my $is_temp = ($view_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1883




 





 





 





 





 





 



     return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' VIEW ' . $view_name . ' AS ' . $query_expression . ';' . "\n"; 




1884




 





 





 





 





 





 



     # Note: Several interesting looking features are not implemented yet. 




1885




 





 





 





 





 





 



 } 




1886




 





 





 





 





 





 



   




1887




 





 





 





 





 





 



 sub build_schema_or_app_view_delete { # SQL:2003, 11.23 "" (p600) 




1888




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




1889




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_view_delete', 




1890




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




1891




 





 





 





 





 





 



     my $view_name = $builder->build_identifier_schema_or_app_obj( $view_node, 1 ); 




1892




 





 





 





 





 





 



     return 'DROP VIEW ' . $view_name . ';' . "\n"; 




1893




 





 





 





 





 





 



 } 




1894




 





 





 





 





 





 



   




1895




 





 





 





 





 





 



 ###################################################################### 




1896




 





 





 





 





 





 



   




1897




 





 





 





 





 





 



 sub build_schema_or_app_routine_create { 




1898




 





 





 





 





 





 



     # SQL:2003, 11.39 "" (p629) 




1899




 





 





 





 





 





 



     # SQL:2003, 11.50 "" (p675) 




1900




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




1901




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_routine_create', 




1902




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




1903




 





 





 





 





 





 



     my $routine_type = $routine_node->get_attribute( 'routine_type' ); 




1904




 





 





 





 





 





 



     my $routine_name = $builder->build_identifier_schema_or_app_obj( $routine_node, 1 ); 




1905




 





 





 





 





 





 



     my $is_temp = ($routine_node->get_primary_parent_attribute()->get_node_type() eq 'application'); 




1906




 





 





 





 





 





 



     if ($routine_type eq 'PACKAGE') { 




1907




 





 





 





 





 





 



         # Not implemented yet. 




1908




 





 





 





 





 





 



     } 




1909




 





 





 





 





 





 



     elsif ($routine_type eq 'TRIGGER') { 




1910




 





 





 





 





 





 



         my $table_or_view_name = $builder->build_identifier_schema_or_app_obj( 




1911




 





 





 





 





 





 



             $routine_node->get_attribute( 'trigger_on' ) ); 




1912




 





 





 





 





 





 



         my $trigger_event = $routine_node->get_attribute( 'trigger_event' ); 




1913




 





 





 





 





 





 



         my $trigger_event_sql 




1914




 





 





 





 





 





 



             = $trigger_event eq 'BEFR_INS' ? 'BEFORE INSERT' 




1915




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_INS' ? 'AFTER INSERT' 




1916




 





 





 





 





 





 



             : $trigger_event eq 'INST_INS' ? 'INSTEAD OF INSERT' 




1917




 





 





 





 





 





 



             : $trigger_event eq 'BEFR_UPD' ? 'BEFORE UPDATE' 




1918




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_UPD' ? 'AFTER UPDATE' 




1919




 





 





 





 





 





 



             : $trigger_event eq 'INST_UPD' ? 'INSTEAD OF UPDATE' 




1920




 





 





 





 





 





 



             : $trigger_event eq 'BEFR_DEL' ? 'BEFORE DELETE' 




1921




 





 





 





 





 





 



             : $trigger_event eq 'AFTR_DEL' ? 'AFTER DELETE' 




1922




 





 





 





 





 





 



             : $trigger_event eq 'INST_DEL' ? 'INSTEAD OF DELETE' 




1923




 





 





 





 





 





 



             :                                undef # we should never get here 




1924




 





 





 





 





 





 



             ; 




1925




 





 





 





 





 





 



             # Note: INSTEAD OF is not standard SQL, but supported by SQLServer 2000, maybe Oracle, ?. 




1926




 





 





 





 





 





 



         my $for_each_stmt = $routine_node->get_attribute( 'trigger_per_stmt' ); 




1927




 





 





 





 





 





 



         # TODO: Implement optional OF . 




1928




 





 





 





 





 





 



         my @transition_var_names = (); # TODO: NEW/OLD ROW AS <... variable name> 




1929




 





 





 





 





 





 



         my $triggered_sql_statement = $builder->build_dmanip_routine_body( $routine_node, 1 ); 




1930




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' TRIGGER ' . $routine_name . ' ' 




1931




 





 





 





 





 





 



             . $trigger_event_sql . ' ON ' . $table_or_view_name 




1932




 





 





 





 





 





 



             . (@transition_var_names ? ' REFERENCING ' . (join ' ', @transition_var_names) : $EMPTY_STR) 




1933




 





 





 





 





 





 



             . ($for_each_stmt ? ' FOR EACH STATEMENT' : ' FOR EACH ROW') 




1934




 





 





 





 





 





 



             # TODO: WHEN (  ) 




1935




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1936




 





 





 





 





 





 



             . $triggered_sql_statement 




1937




 





 





 





 





 





 



             . ';' . "\n"; 




1938




 





 





 





 





 





 



     } 




1939




 





 





 





 





 





 



     elsif ($routine_type eq 'PROCEDURE') { 




1940




 





 





 





 





 





 



         my $routine_args = $builder->build_dmanip_routine_args( $routine_node ); 




1941




 





 





 





 





 





 



         # TODO:  where appropriate. 




1942




 





 





 





 





 





 



         my $routine_body = $builder->build_dmanip_routine_body( $routine_node ); 




1943




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' PROCEDURE ' . $routine_name 




1944




 





 





 





 





 





 



             . $routine_args 




1945




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1946




 





 





 





 





 





 



             . ' ' . $routine_body . ';' . "\n"; 




1947




 





 





 





 





 





 



     } 




1948




 





 





 





 





 





 



     elsif ($routine_type eq 'FUNCTION') { 




1949




 





 





 





 





 





 



         my $routine_args = $builder->build_dmanip_routine_args( $routine_node ); 




1950




 





 





 





 





 





 



         # TODO:  where appropriate. 




1951




 





 





 





 





 





 



         my $routine_body = $builder->build_dmanip_routine_body( $routine_node ); 




1952




 





 





 





 





 





 



         my $return_cont_type = $routine_node->get_attribute( 'return_cont_type' ); 




1953




 





 





 





 





 





 



         my $return_data_type = $EMPTY_STR; 




1954




 





 





 





 





 





 



         if ($return_cont_type eq 'ERROR') { 




1955




 





 





 





 





 





 



             # Not implemented yet. 




1956




 





 





 





 





 





 



         } 




1957




 





 





 





 





 





 



         elsif ($return_cont_type eq 'SCALAR') { 




1958




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_scalar_data_type' ); 




1959




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




1960




 





 





 





 





 





 



         } 




1961




 





 





 





 





 





 



         elsif ($return_cont_type eq 'ROW') { 




1962




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_row_data_type' ); 




1963




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




1964




 





 





 





 





 





 



         } 




1965




 





 





 





 





 





 



         elsif ($return_cont_type eq 'SC_ARY') { 




1966




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_scalar_data_type' ); 




1967




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ) . ' ARRAY'; 




1968




 





 





 





 





 





 



         } 




1969




 





 





 





 





 





 



         elsif ($return_cont_type eq 'RW_ARY') { 




1970




 





 





 





 





 





 



             my $dt_or_dom_node = $routine_node->get_attribute( 'return_row_data_type' ); 




1971




 





 





 





 





 





 



             my $return_data_type = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ) . ' ARRAY'; 




1972




 





 





 





 





 





 



         } 




1973




 





 





 





 





 





 



         elsif ($return_cont_type eq 'CONN') { 




1974




 





 





 





 





 





 



             # Not implemented yet. 




1975




 





 





 





 





 





 



         } 




1976




 





 





 





 





 





 



         elsif ($return_cont_type eq 'CURSOR') { 




1977




 





 





 





 





 





 



             # Not implemented yet. 




1978




 





 





 





 





 





 



         } 




1979




 





 





 





 





 





 



         elsif ($return_cont_type eq 'LIST') { 




1980




 





 





 





 





 





 



             # Not implemented yet. 




1981




 





 





 





 





 





 



         } 




1982




 





 





 





 





 





 



         else {} 




1983




 





 





 





 





 





 



         return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' FUNCTION ' . $routine_name 




1984




 





 





 





 





 





 



             . $routine_args 




1985




 





 





 





 





 





 



             . ' RETURNS ' . $return_data_type 




1986




 





 





 





 





 





 



             . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR) 




1987




 





 





 





 





 





 



             . ' ' . $routine_body . ';' . "\n"; 




1988




 





 





 





 





 





 



     } 




1989




 





 





 





 





 





 



     else {} # $routine_type eq 'BLOCK' 




1990




 





 





 





 





 





 



         # 'BLOCK': no-op; you should call build_dmanip_routine_body() directly instead 




1991




 





 





 





 





 





 



 } 




1992




 





 





 





 





 





 



   




1993




 





 





 





 





 





 



 sub build_schema_or_app_routine_delete { 




1994




 





 





 





 





 





 



     # SQL:2003, 11.40 "" (p633) 




1995




 





 





 





 





 





 



     # SQL:2003, 11.52 "" (p703) 




1996




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




1997




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_schema_or_app_routine_delete', 




1998




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




1999




 





 





 





 





 





 



     my $routine_type = $routine_node->get_attribute( 'routine_type' ); 




2000




 





 





 





 





 





 



     my $routine_name = $builder->build_identifier_schema_or_app_obj( $routine_node, 1 ); 




2001




 





 





 





 





 





 



     # Note: 10.6 "" (p499) may be useful later. 




2002




 





 





 





 





 





 



     if ($routine_type eq 'PACKAGE') { 




2003




 





 





 





 





 





 



         # Not implemented yet. 




2004




 





 





 





 





 





 



     } 




2005




 





 





 





 





 





 



     elsif ($routine_type eq 'TRIGGER') { 




2006




 





 





 





 





 





 



         return 'DROP TRIGGER ' . $routine_name . ';' . "\n"; 




2007




 





 





 





 





 





 



     } 




2008




 





 





 





 





 





 



     elsif ($routine_type eq 'PROCEDURE') { 




2009




 





 





 





 





 





 



         return 'DROP PROCEDURE ' . $routine_name . ';' . "\n"; 




2010




 





 





 





 





 





 



     } 




2011




 





 





 





 





 





 



     elsif ($routine_type eq 'FUNCTION') { 




2012




 





 





 





 





 





 



         return 'DROP FUNCTION ' . $routine_name . ';' . "\n"; 




2013




 





 





 





 





 





 



     } 




2014




 





 





 





 





 





 



     else {} # $routine_type eq 'BLOCK'; no-op 




2015




 





 





 





 





 





 



 } 




2016




 





 





 





 





 





 



   




2017




 





 





 





 





 





 



 ###################################################################### 




2018




 





 





 





 





 





 



   




2019




 





 





 





 





 





 



 sub build_access_role_create { # SQL:2003, 12.4 "" (p743) 




2020




 





 





 





 





 





 



     my ($builder, $role_node) = @_; 




2021




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_role_create', 




2022




 





 





 





 





 





 



         'ROLE_NODE', ['role'], $role_node ); 




2023




 





 





 





 





 





 



     my $role_name = $builder->build_identifier_element( $role_node ); 




2024




 





 





 





 





 





 



     return 'CREATE ROLE ' . $role_name . ';' . "\n"; 




2025




 





 





 





 





 





 



 } 




2026




 





 





 





 





 





 



   




2027




 





 





 





 





 





 



 sub build_access_role_delete { # SQL:2003, 12.6 "" (p746) 




2028




 





 





 





 





 





 



     my ($builder, $role_node) = @_; 




2029




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_role_delete', 




2030




 





 





 





 





 





 



         'ROLE_NODE', ['role'], $role_node ); 




2031




 





 





 





 





 





 



     my $role_name = $builder->build_identifier_element( $role_node ); 




2032




 





 





 





 





 





 



     return 'DROP ROLE ' . $role_name . ';' . "\n"; 




2033




 





 





 





 





 





 



 } 




2034




 





 





 





 





 





 



   




2035




 





 





 





 





 





 



 ###################################################################### 




2036




 





 





 





 





 





 



   




2037




 





 





 





 





 





 



 sub build_access_grant { 




2038




 





 





 





 





 





 



     # Function returns empty string if given grantee has no privileges. 




2039




 





 





 





 





 





 



     # SQL:2003, 12.1 "" (p731) 




2040




 





 





 





 





 





 



     # SQL:2003, 12.2 "" (p736) 




2041




 





 





 





 





 





 



     # SQL:2003, 12.3 "" (p739) 




2042




 





 





 





 





 





 



     # SQL:2003, 12.5 "" (p744) 




2043




 





 





 





 





 





 



     my ($builder, $grantee_node) = @_; 




2044




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_grant', 




2045




 





 





 





 





 





 



         'GRANTEE_NODE', ['role','user'], $grantee_node ); 




2046




 





 





 





 





 





 



     my $node_type = $grantee_node->get_node_type(); 




2047




 





 





 





 





 





 



     my $grantee_name = $builder->build_identifier_schema_or_app_obj( $grantee_node ); 




2048




 





 





 





 





 





 



     if ($node_type eq 'role') { 




2049




 





 





 





 





 





 



         my @grant_stmts = (); 




2050




 





 





 





 





 





 



         for my $priv_on_node (@{$grantee_node->get_child_nodes( 'privilege_on' )}) { 




2051




 





 





 





 





 





 



             my $object_node = $priv_on_node->get_attribute( 'si_priv_on' ); 




2052




 





 





 





 





 





 



             my $object_name = $builder->build_identifier_schema_or_app_obj( $object_node ); 




2053




 





 





 





 





 





 



             my @priv_types = map { $_->get_attribute( 'si_priv_type' ) } 




2054




 





 





 





 





 





 



                 @{$priv_on_node->get_child_nodes( 'privilege_for' )}; 




2055




 





 





 





 





 





 



             my @object_privs = (); 




2056




 





 





 





 





 





 



             if (grep { $_ eq 'ALL' } @priv_types) { 




2057




 





 





 





 





 





 



                 push @object_privs, 'ALL PRIVILEGES'; 




2058




 





 





 





 





 





 



             } 




2059




 





 





 





 





 





 



             else { 




2060




 





 





 





 





 





 



                 for my $priv_type (@priv_types) { 




2061




 





 





 





 





 





 



                     push @object_privs, 




2062




 





 





 





 





 





 



                            $priv_type eq 'SELECT' ? 'SELECT' # TODO: allow only specific columns 




2063




 





 





 





 





 





 



                          : $priv_type eq 'DELETE' ? 'DELETE' 




2064




 





 





 





 





 





 



                          : $priv_type eq 'INSERT' ? 'INSERT' # TODO: allow only specific columns 




2065




 





 





 





 





 





 



                          : $priv_type eq 'UPDATE' ? 'UPDATE' # TODO: allow only specific columns 




2066




 





 





 





 





 





 



                          :                          $EMPTY_STR # TODO: REFERENCES, USAGE, TRIGGER, UNDER, EXECUTE; what do they mean? 




2067




 





 





 





 





 





 



                          ; 




2068




 





 





 





 





 





 



                 } 




2069




 





 





 





 





 





 



             } 




2070




 





 





 





 





 





 



             push @grant_stmts, 'GRANT ' . (join q{, }, @object_privs) 




2071




 





 





 





 





 





 



                 . ' ON ' . $object_name . ' TO ' . $grantee_name . ';'; 




2072




 





 





 





 





 





 



         } 




2073




 





 





 





 





 





 



         return join $EMPTY_STR, @grant_stmts; 




2074




 





 





 





 





 





 



     } 




2075




 





 





 





 





 





 



     elsif ($node_type eq 'user') { 




2076




 





 





 





 





 





 



         my @role_names = map { $builder->build_identifier_schema_or_app_obj( $_ ) } 




2077




 





 





 





 





 





 



             @{$grantee_node->get_child_nodes( 'user_role' )}; 




2078




 





 





 





 





 





 



         return @role_names ? 'GRANT ' . (join q{, }, @role_names) . ' TO ' . $grantee_name . ';' : $EMPTY_STR; 




2079




 





 





 





 





 





 



     } 




2080




 





 





 





 





 





 



     else {} 




2081




 





 





 





 





 





 



 } 




2082




 





 





 





 





 





 



   




2083




 





 





 





 





 





 



 sub build_access_revoke { 




2084




 





 





 





 





 





 



     # SQL:2003, 12.7 "" (p747) 




2085




 





 





 





 





 





 



     # SQL:2003, 12.3 "" (p739) 




2086




 





 





 





 





 





 



     my ($builder, $grantee_node) = @_; 




2087




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_access_revoke', 




2088




 





 





 





 





 





 



         'GRANTEE_NODE', ['role','user'], $grantee_node ); 




2089




 





 





 





 





 





 



     my $node_type = $grantee_node->get_node_type(); 




2090




 





 





 





 





 





 



     my $grantee_name = $builder->build_identifier_schema_or_app_obj( $grantee_node ); 




2091




 





 





 





 





 





 



     if ($node_type eq 'role') { 




2092




 





 





 





 





 





 



         my @revoke_stmts = (); 




2093




 





 





 





 





 





 



         for my $priv_on_node (@{$grantee_node->get_child_nodes( 'privilege_on' )}) { 




2094




 





 





 





 





 





 



             my $object_node = $priv_on_node->get_attribute( 'si_priv_on' ); 




2095




 





 





 





 





 





 



             my $object_name = $builder->build_identifier_schema_or_app_obj( $object_node ); 




2096




 





 





 





 





 





 



             push @revoke_stmts, 'REVOKE ALL PRIVILEGES' 




2097




 





 





 





 





 





 



                 . ' ON ' . $object_name . ' FROM ' . $grantee_name . ';'; 




2098




 





 





 





 





 





 



         } 




2099




 





 





 





 





 





 



         return join $EMPTY_STR, @revoke_stmts; 




2100




 





 





 





 





 





 



     } 




2101




 





 





 





 





 





 



     elsif ($node_type eq 'user') { 




2102




 





 





 





 





 





 



         my @role_names = map { $builder->build_identifier_schema_or_app_obj( $_ ) } 




2103




 





 





 





 





 





 



             @{$grantee_node->get_child_nodes( 'user_role' )}; 




2104




 





 





 





 





 





 



         return @role_names ? 'REVOKE ' . (join q{, }, @role_names) . ' FROM ' . $grantee_name . ';' : $EMPTY_STR; 




2105




 





 





 





 





 





 



     } 




2106




 





 





 





 





 





 



     else {} 




2107




 





 





 





 





 





 



 } 




2108




 





 





 





 





 





 



   




2109




 





 





 





 





 





 



 ###################################################################### 




2110




 





 





 





 





 





 



   




2111




 





 





 





 





 





 



 sub build_dmanip_routine_args { 




2112




 





 





 





 





 





 



     my ($builder, $routine_node) = @_; 




2113




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_args', 




2114




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




2115




 





 





 





 





 





 



     # SQL:2003, 11.50 "" (p675) 




2116




 





 





 





 





 





 



     # in particular see  




2117




 





 





 





 





 





 



     my @rtn_arg_declare_sql = (); 




2118




 





 





 





 





 





 



     for my $rtn_arg_node (@{$routine_node->get_child_nodes( 'routine_arg' )}) { 




2119




 





 





 





 





 





 



         # TODO:  ::= IN | OUT | INOUT 




2120




 





 





 





 





 





 



         my $arg_name = $builder->build_identifier_element( $rtn_arg_node ); 




2121




 





 





 





 





 





 



         my $cont_type = $rtn_arg_node->get_attribute( 'cont_type' ); 




2122




 





 





 





 





 





 



         if ($cont_type eq 'ERROR') { 




2123




 





 





 





 





 





 



             # Not implemented yet. 




2124




 





 





 





 





 





 



         } 




2125




 





 





 





 





 





 



         elsif ($cont_type eq 'SCALAR') { 




2126




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'scalar_data_type' ); 




2127




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2128




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ';'; 




2129




 





 





 





 





 





 



         } 




2130




 





 





 





 





 





 



         elsif ($cont_type eq 'ROW') { 




2131




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'row_data_type' ); 




2132




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2133




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ';'; 




2134




 





 





 





 





 





 



         } 




2135




 





 





 





 





 





 



         elsif ($cont_type eq 'SC_ARY') { 




2136




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'scalar_data_type' ); 




2137




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2138




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2139




 





 





 





 





 





 



         } 




2140




 





 





 





 





 





 



         elsif ($cont_type eq 'RW_ARY') { 




2141




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'row_data_type' ); 




2142




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2143




 





 





 





 





 





 



             push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2144




 





 





 





 





 





 



         } 




2145




 





 





 





 





 





 



         elsif ($cont_type eq 'CONN') { 




2146




 





 





 





 





 





 



             # Not implemented yet. 




2147




 





 





 





 





 





 



         } 




2148




 





 





 





 





 





 



         elsif ($cont_type eq 'CURSOR') { 




2149




 





 





 





 





 





 



             # Not implemented yet. 




2150




 





 





 





 





 





 



         } 




2151




 





 





 





 





 





 



         elsif ($cont_type eq 'LIST') { 




2152




 





 





 





 





 





 



             # Not implemented yet. 




2153




 





 





 





 





 





 



         } 




2154




 





 





 





 





 





 



         else {} 




2155




 





 





 





 





 





 



     } 




2156




 





 





 





 





 





 



     return @rtn_arg_declare_sql ? '(' . (join q{, }, @rtn_arg_declare_sql) . ')' : $EMPTY_STR; 




2157




 





 





 





 





 





 



 } 




2158




 





 





 





 





 





 



   




2159




 





 





 





 





 





 



 sub build_dmanip_routine_body { 




2160




 





 





 





 





 





 



     # Corresponds to these sections: 




2161




 





 





 





 





 





 



     # ? 




2162




 





 





 





 





 





 



     # SQL:2003, 6.1 "" (p161) 




2163




 





 





 





 





 





 



     # SQL:2003, 13.5 "" (p790) 




2164




 





 





 





 





 





 



     # SQL:2003, 14.1 "" (p809) 




2165




 





 





 





 





 





 



     my ($builder, $routine_node, $is_atomic) = @_; 




2166




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_body', 




2167




 





 





 





 





 





 



         'ROUTINE_NODE', ['routine'], $routine_node ); 




2168




 





 





 





 





 





 



     my $is_ora_routines = $builder->{$PROP_ORA_ROUTINES}; 




2169




 





 





 





 





 





 



     my @rtn_var_declare_sql = (); 




2170




 





 





 





 





 





 



     for my $rtn_var_node (@{$routine_node->get_child_nodes( 'routine_var' )}) { 




2171




 





 





 





 





 





 



         my $var_name = $builder->build_identifier_element( $rtn_var_node ); 




2172




 





 





 





 





 





 



         my $cont_type = $rtn_var_node->get_attribute( 'cont_type' ); 




2173




 





 





 





 





 





 



         if ($cont_type eq 'ERROR') { 




2174




 





 





 





 





 





 



             # Not implemented yet. 




2175




 





 





 





 





 





 



         } 




2176




 





 





 





 





 





 



         elsif ($cont_type eq 'SCALAR') { 




2177




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'scalar_data_type' ); 




2178




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2179




 





 





 





 





 





 



             my $init_lit_val = $rtn_var_node->get_attribute( 'init_lit_val' ); 




2180




 





 





 





 





 





 



             my $is_constant = $rtn_var_node->get_attribute( 'is_constant' ); 




2181




 





 





 





 





 





 



             push @rtn_var_declare_sql, 




2182




 





 





 





 





 





 



                 ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') 




2183




 





 





 





 





 





 



                 . $var_name . ' ' . $dt_or_dom_sql 




2184




 





 





 





 





 





 



                 # TODO: use $is_constant 




2185




 





 





 





 





 





 



                 . (defined $init_lit_val ? ' DEFAULT ' . $builder->quote_literal( $init_lit_val, 




2186




 





 





 





 





 





 



                     $builder->_scalar_data_type_of_node( $rtn_var_node )->get_attribute( 'base_type' ) ) : $EMPTY_STR) 




2187




 





 





 





 





 





 



                 . ';' 




2188




 





 





 





 





 





 



             ; 




2189




 





 





 





 





 





 



         } 




2190




 





 





 





 





 





 



         elsif ($cont_type eq 'ROW') { 




2191




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'row_data_type' ); 




2192




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2193




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ';'; 




2194




 





 





 





 





 





 



         } 




2195




 





 





 





 





 





 



         elsif ($cont_type eq 'SC_ARY') { 




2196




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'scalar_data_type' ); 




2197




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ); 




2198




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2199




 





 





 





 





 





 



         } 




2200




 





 





 





 





 





 



         elsif ($cont_type eq 'RW_ARY') { 




2201




 





 





 





 





 





 



             my $dt_or_dom_node = $rtn_var_node->get_attribute( 'row_data_type' ); 




2202




 





 





 





 





 





 



             my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ); 




2203




 





 





 





 





 





 



             push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ' ARRAY;'; 




2204




 





 





 





 





 





 



         } 




2205




 





 





 





 





 





 



         elsif ($cont_type eq 'CONN') { 




2206




 





 





 





 





 





 



             # Not implemented yet. 




2207




 





 





 





 





 





 



         } 




2208




 





 





 





 





 





 



         elsif ($cont_type eq 'CURSOR') { 




2209




 





 





 





 





 





 



             if (my $view_node = (@{$rtn_var_node->get_child_nodes( 'view' )})[0]) { 




2210




 





 





 





 





 





 



                 # Since we got here, cursor will be defined within curr rtn, regardless of share or not. 




2211




 





 





 





 





 





 



                 my $query_expr = $builder->build_query_query_expr( $view_node ); 




2212




 





 





 





 





 





 



                 my $order_by_clause = $builder->build_query_window_clause( $view_node ); 




2213




 





 





 





 





 





 



                 my $updatability_clause 




2214




 





 





 





 





 





 



                     = $rtn_var_node->get_attribute( 'curs_for_update' ) ? 'FOR UPDATE' 




2215




 





 





 





 





 





 



                     :                                                     'FOR READ ONLY'; # TODO: [ OF  ] 




2216




 





 





 





 





 





 



                 # TODO: sensitivity, scrollability, holdability, returnability 




2217




 





 





 





 





 





 



                 my $cursor_spec = $query_expr . ' ' . $order_by_clause . ' ' . $updatability_clause; 




2218




 





 





 





 





 





 



                 push @rtn_var_declare_sql, 'DECLARE ' . $var_name . ' CURSOR FOR ' . $cursor_spec . ';'; 




2219




 





 





 





 





 





 



             } 




2220




 





 





 





 





 





 



             else { 




2221




 





 





 





 





 





 



                 # Not implemented yet; but also not sure of proper way to implement. 




2222




 





 





 





 





 





 



                 # If we got here then cursor had been declared in diff rtn and passed to curr one. 




2223




 





 





 





 





 





 



                 # We can't just make another copy of decl since may use vars/args/etc of other rtn. 




2224




 





 





 





 





 





 



                 push @rtn_var_declare_sql, 'DECLARE ' . $var_name . ';'; 




2225




 





 





 





 





 





 



             } 




2226




 





 





 





 





 





 



         } 




2227




 





 





 





 





 





 



         elsif ($cont_type eq 'LIST') { 




2228




 





 





 





 





 





 



             # Not implemented yet. 




2229




 





 





 





 





 





 



         } 




2230




 





 





 





 





 





 



         else {} 




2231




 





 





 





 





 





 



     } 




2232




 





 





 





 





 





 



     my @rtn_stmt_sql = (); 




2233




 





 





 





 





 





 



     for my $rtn_stmt_node (@{$routine_node->get_child_nodes( 'routine_stmt' )}) { 




2234




 





 





 





 





 





 



         push @rtn_stmt_sql, $builder->build_dmanip_routine_stmt( $rtn_stmt_node ); 




2235




 





 





 





 





 





 



     } 




2236




 





 





 





 





 





 



     my $atomic_clause = $is_atomic ? 'ATOMIC ' : $EMPTY_STR; 




2237




 





 





 





 





 





 



     return join ' ', 




2238




 





 





 





 





 





 



         # TODO: proper handling of vars declared within 'BLOCK' routines, when in Oracle syntax. 




2239




 





 





 





 





 





 



         ($is_ora_routines ? 'VAR ' : 'BEGIN ' . $atomic_clause), 




2240




 





 





 





 





 





 



         @rtn_var_declare_sql, 




2241




 





 





 





 





 





 



         ($is_ora_routines ? 'BEGIN ' . $atomic_clause : $EMPTY_STR), 




2242




 





 





 





 





 





 



         @rtn_stmt_sql, 




2243




 





 





 





 





 





 



         'END;' 




2244




 





 





 





 





 





 



     ; 




2245




 





 





 





 





 





 



 } 




2246




 





 





 





 





 





 



   




2247




 





 





 





 





 





 



 ###################################################################### 




2248




 





 





 





 





 





 



   




2249




 





 





 





 





 





 



 sub build_dmanip_routine_stmt { 




2250




 





 





 





 





 





 



     # SQL:2003, 13.5 "" (p790) 




2251




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2252




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_routine_stmt', 




2253




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2254




 





 





 





 





 





 



     if (my $compound_stmt_routine = $rtn_stmt_node->get_attribute( 'block_routine' )) { 




2255




 





 





 





 





 





 



         return $builder->build_dmanip_routine_body( $compound_stmt_routine ); 




2256




 





 





 





 





 





 



     } 




2257




 





 





 





 





 





 



     elsif (my $assign_dest_node = $rtn_stmt_node->get_attribute( 'assign_dest' ) || 




2258




 





 





 





 





 





 



             $rtn_stmt_node->get_attribute( 'assign_dest' )) { 




2259




 





 





 





 





 





 



         my $dest = $builder->build_identifier_element( $assign_dest_node ); 




2260




 





 





 





 





 





 



         my $src = $builder->build_expr( 




2261




 





 





 





 





 





 



             $rtn_stmt_node->get_child_nodes( 'routine_expr' )->[0] ); 




2262




 





 





 





 





 





 



         if ($builder->{$PROP_ORA_ROUTINES}) { 




2263




 





 





 





 





 





 



             return $dest . ' := ' . $src . ';' . "\n"; 




2264




 





 





 





 





 





 



         } 




2265




 





 





 





 





 





 



         else { 




2266




 





 





 





 





 





 



             return 'SET ' . $dest . ' = ' . $src . ';' . "\n"; 




2267




 





 





 





 





 





 



         } 




2268




 





 





 





 





 





 



     } 




2269




 





 





 





 





 





 



     elsif ($rtn_stmt_node->get_attribute( 'call_sroutine' )) { 




2270




 





 





 





 





 





 



         return $builder->build_dmanip_call_sroutine( $rtn_stmt_node ); 




2271




 





 





 





 





 





 



     } 




2272




 





 





 





 





 





 



     elsif ($rtn_stmt_node->get_attribute( 'call_uroutine' )) { 




2273




 





 





 





 





 





 



         return $builder->build_dmanip_call_uroutine( $rtn_stmt_node ); 




2274




 





 





 





 





 





 



     } 




2275




 





 





 





 





 





 



     else {} 




2276




 





 





 





 





 





 



 } 




2277




 





 





 





 





 





 



   




2278




 





 





 





 





 





 



 ###################################################################### 




2279




 





 





 





 





 





 



   




2280




 





 





 





 





 





 



 sub build_dmanip_call_sroutine { 




2281




 





 





 





 





 





 



     # Corresponds to these sections: 




2282




 





 





 





 





 





 



     # SQL:2003, 14.2 "" (p815) 




2283




 





 





 





 





 





 



     # SQL:2003, 14.3 "" (p817) 




2284




 





 





 





 





 





 



     # SQL:2003, 14.4 "" (p822) 




2285




 





 





 





 





 





 



     # SQL:2003, 15.2 "" (p886) 




2286




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2287




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_call_sroutine', 




2288




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2289




 





 





 





 





 





 



     my $sroutine = $rtn_stmt_node->get_attribute( 'call_sroutine' ); 




2290




 





 





 





 





 





 



     my %child_exprs = map { ( 




2291




 





 





 





 





 





 



             ($_->get_attribute( 'call_sroutine_cxt' ) || 




2292




 





 





 





 





 





 



                 $_->get_attribute( 'call_sroutine_arg' )) => $_ 




2293




 





 





 





 





 





 



         ) } @{$rtn_stmt_node->get_child_nodes( 'routine_expr' )}; 




2294




 





 





 





 





 





 



     if ($sroutine eq 'RETURN') { 




2295




 





 





 





 





 





 



         my $return_value = $builder->build_expr( $child_exprs{'RETURN_VALUE'} ); 




2296




 





 





 





 





 





 



         return 'RETURN ' . $return_value . ';' . "\n"; # no parens in standard 




2297




 





 





 





 





 





 



     } 




2298




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_OPEN') { # opens a select cursor for reading from (or performs a select if in right context) 




2299




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2300




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2301




 





 





 





 





 





 



         return 'OPEN ' . $cursor_cx_name . ';' . "\n"; 




2302




 





 





 





 





 





 



     } 




2303




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_CLOSE') { # closes a select cursor when you're done with it 




2304




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2305




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2306




 





 





 





 





 





 



         return 'CLOSE ' . $cursor_cx_name . ';' . "\n"; 




2307




 





 





 





 





 





 



     } 




2308




 





 





 





 





 





 



     elsif ($sroutine eq 'CURSOR_FETCH') { # reads a row from an opened cursor and puts it in a row/list variable 




2309




 





 





 





 





 





 



         my $cursor_cx_name = $builder->build_identifier_element( 




2310




 





 





 





 





 





 



             $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) ); 




2311




 





 





 





 





 





 



         my $fetch_orient = $EMPTY_STR; # TODO: the explicit  options; NEXT is default 




2312




 





 





 





 





 





 



         my $query_dest_name = $builder->build_identifier_element( 




2313




 





 





 





 





 





 



             $child_exprs{'INTO'}->get_attribute( 'query_dest' ) ); 




2314




 





 





 





 





 





 



         return 'FETCH ' . $fetch_orient . ' FROM ' . $cursor_cx_name . ' INTO ' . $query_dest_name . ';' . "\n"; 




2315




 





 





 





 





 





 



     } 




2316




 





 





 





 





 





 



     elsif ($sroutine eq 'SELECT') { # fetches one row from a table/view and puts it in a row/list variable 




2317




 





 





 





 





 





 



         my $view_node = $child_exprs{'SELECT_DEFN'}->get_attribute( 'act_on' ); 




2318




 





 





 





 





 





 



         return $builder->build_query_query_spec( $view_node, 




2319




 





 





 





 





 





 



             $child_exprs{'INTO'}->get_attribute( 'query_dest' ) ) . ';' . "\n"; 




2320




 





 





 





 





 





 



     } 




2321




 





 





 





 





 





 



     elsif ($sroutine eq 'INSERT') { # inserts a row into a table/view 




2322




 





 





 





 





 





 



         my $view_node = $child_exprs{'INSERT_DEFN'}->get_attribute( 'act_on' ); 




2323




 





 





 





 





 





 



         return $builder->build_dmanip_insert_stmt( $view_node ); 




2324




 





 





 





 





 





 



     } 




2325




 





 





 





 





 





 



     elsif ($sroutine eq 'UPDATE') { # updates a row in a table/view 




2326




 





 





 





 





 





 



         my $view_node = $child_exprs{'UPDATE_DEFN'}->get_attribute( 'act_on' ); 




2327




 





 





 





 





 





 



         return $builder->build_dmanip_update_stmt( $view_node ); 




2328




 





 





 





 





 





 



     } 




2329




 





 





 





 





 





 



     elsif ($sroutine eq 'DELETE') { # deletes a row in a table/view 




2330




 





 





 





 





 





 



         my $view_node = $child_exprs{'DELETE_DEFN'}->get_attribute( 'act_on' ); 




2331




 





 





 





 





 





 



         return $builder->build_dmanip_delete_stmt( $view_node ); 




2332




 





 





 





 





 





 



     } 




2333




 





 





 





 





 





 



     elsif ($sroutine eq 'COMMIT') { # commits the current transaction, then starts a new one 




2334




 





 





 





 





 





 



         return 'COMMIT; START TRANSACTION;' . "\n"; 




2335




 





 





 





 





 





 



         # Note: According to the MySQL manual: 




2336




 





 





 





 





 





 



         # For transaction-safe tables, there are actions (other than typing COMMIT) 




2337




 





 





 





 





 





 



         # that will automatically trigger a COMMIT. Requesting a lock will implicitly 




2338




 





 





 





 





 





 



         # commit any outstanding queries. 




2339




 





 





 





 





 





 



     } 




2340




 





 





 





 





 





 



     elsif ($sroutine eq 'ROLLBACK') { # rolls back the current transaction, then starts a new one 




2341




 





 





 





 





 





 



         return 'ROLLBACK; START TRANSACTION;' . "\n"; # TODO: rollback to a named save point only 




2342




 





 





 





 





 





 



     } 




2343




 





 





 





 





 





 



     else {} # There are a bunch more that aren't implemented yet. 




2344




 





 





 





 





 





 



 } 




2345




 





 





 





 





 





 



   




2346




 





 





 





 





 





 



 ###################################################################### 




2347




 





 





 





 





 





 



   




2348




 





 





 





 





 





 



 sub build_dmanip_src_schema_object_name { 




2349




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2350




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_src_schema_object_name', 




2351




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2352




 





 





 





 





 





 



     my $view_type = $view_node->get_attribute( 'view_type' ); 




2353




 





 





 





 





 





 



     my @view_src_nodes = @{$view_node->get_child_nodes( 'view_src' )}; 




2354




 





 





 





 





 





 



     if (@view_src_nodes == 0) { 




2355




 





 





 





 





 





 



         return; # No source at all. 




2356




 





 





 





 





 





 



     } 




2357




 





 





 





 





 





 



     elsif ($view_type eq 'ALIAS' or @view_src_nodes == 1) { 




2358




 





 





 





 





 





 



         my $object_node = $view_src_nodes[0]->get_attribute( 'match' ); 




2359




 





 





 





 





 





 



         if ($object_node->get_primary_parent_attribute()->get_node_type() eq 'schema') { 




2360




 





 





 





 





 





 



             # The only source is a schema object, table or named view; use it directly. 




2361




 





 





 





 





 





 



             return $builder->build_identifier_schema_or_app_obj( $object_node ); 




2362




 





 





 





 





 





 



         } 




2363




 





 





 





 





 





 



         else { 




2364




 





 





 





 





 





 



             # The only source seems to be a sub-query in "from". 




2365




 





 





 





 





 





 



             return; # Adding recursion in all necessary places too complicated for now. 




2366




 





 





 





 





 





 



         } 




2367




 





 





 





 





 





 



     } 




2368




 





 





 





 





 





 



     else { # @view_src_nodes >= 2 




2369




 





 





 





 





 





 



         return; # Manual updates against multiple sources too complicated for now. 




2370




 





 





 





 





 





 



     } 




2371




 





 





 





 





 





 



 } 




2372




 





 





 





 





 





 



   




2373




 





 





 





 





 





 



 ###################################################################### 




2374




 





 





 





 





 





 



   




2375




 





 





 





 





 





 



 sub build_dmanip_insert_stmt { 




2376




 





 





 





 





 





 



     # SQL:2003, 7.3 "" (p298) 




2377




 





 





 





 





 





 



     # SQL:2003, 14.8 "" (p834) 




2378




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2379




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_insert_stmt', 




2380




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2381




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2382




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2383




 





 





 





 





 





 



     my @set_expr_nodes 




2384




 





 





 





 





 





 



         = grep { $_->get_attribute( 'view_part' ) eq 'SET' } 




2385




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




2386




 





 





 





 





 





 



     my @set_fields_list = (); 




2387




 





 





 





 





 





 



     my @set_values_list = (); 




2388




 





 





 





 





 





 



     for my $expr_node (@set_expr_nodes) { 




2389




 





 





 





 





 





 



         push @set_fields_list, $builder->build_identifier_element( 




2390




 





 





 





 





 





 



             $expr_node->get_attribute( 'set_src_field' ) ); 




2391




 





 





 





 





 





 



         push @set_values_list, $builder->build_expr( $expr_node ); 




2392




 





 





 





 





 





 



     } 




2393




 





 





 





 





 





 



     my $insert_fields_and_src = '(' . (join q{, }, @set_fields_list) . ') ' 




2394




 





 





 





 





 





 



         . 'VALUES (' . (join q{, }, @set_values_list) . ')'; 




2395




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2396




 





 





 





 





 





 



     return 'INSERT INTO ' . $object_name . ' ' . $insert_fields_and_src . ';' . "\n"; 




2397




 





 





 





 





 





 



 } 




2398




 





 





 





 





 





 



   




2399




 





 





 





 





 





 



 ###################################################################### 




2400




 





 





 





 





 





 



   




2401




 





 





 





 





 





 



 sub build_dmanip_update_stmt { 




2402




 





 





 





 





 





 



     # SQL:2003, 14.11 "" (p849) 




2403




 





 





 





 





 





 



     # SQL:2003, 14.12 "" (p853) 




2404




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2405




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_update_stmt', 




2406




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2407




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2408




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2409




 





 





 





 





 





 



     my @set_expr_nodes 




2410




 





 





 





 





 





 



         = grep { $_->get_attribute( 'view_part' ) eq 'SET' } 




2411




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




2412




 





 





 





 





 





 



     my @set_clause_list = (); 




2413




 





 





 





 





 





 



     for my $expr_node (@set_expr_nodes) { 




2414




 





 





 





 





 





 



         my $set_target = $builder->build_identifier_element( 




2415




 





 





 





 





 





 



             $expr_node->get_attribute( 'set_src_field' ) ); 




2416




 





 





 





 





 





 



         my $update_source = $builder->build_expr( $expr_node ); 




2417




 





 





 





 





 





 



         push @set_clause_list, $set_target . ' = ' . $update_source; 




2418




 





 





 





 





 





 



     } 




2419




 





 





 





 





 





 



     my $set_clause = 'SET ' . (join q{, }, @set_clause_list); 




2420




 





 





 





 





 





 



     my $where_clause = $builder->build_query_where_clause( $view_node ); 




2421




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2422




 





 





 





 





 





 



     return 'UPDATE ' . $object_name . ' ' . $set_clause . ' ' . $where_clause . ';' . "\n"; 




2423




 





 





 





 





 





 



 } 




2424




 





 





 





 





 





 



   




2425




 





 





 





 





 





 



 ###################################################################### 




2426




 





 





 





 





 





 



   




2427




 





 





 





 





 





 



 sub build_dmanip_delete_stmt { # SQL:2003, 14.7 "" (p831) 




2428




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2429




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_delete_stmt', 




2430




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2431




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2432




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2433




 





 





 





 





 





 



     my $where_clause = $builder->build_query_where_clause( $view_node ); 




2434




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2435




 





 





 





 





 





 



     return 'DELETE FROM ' . $object_name . ' ' . $where_clause . ';' . "\n"; 




2436




 





 





 





 





 





 



 } 




2437




 





 





 





 





 





 



   




2438




 





 





 





 





 





 



 ###################################################################### 




2439




 





 





 





 





 





 



   




2440




 





 





 





 





 





 



 sub build_dmanip_call_uroutine { 




2441




 





 





 





 





 





 



     # SQL:2003 ...  ... 




2442




 





 





 





 





 





 



     # SQL:2003, 15.1 "" (p885) 




2443




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2444




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_call_uroutine', 




2445




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2446




 





 





 





 





 





 



     my $uroutine = $rtn_stmt_node->get_attribute( 'call_uroutine' ); 




2447




 





 





 





 





 





 



     my $uroutine_name = $builder->build_identifier_schema_or_app_obj( $uroutine ); 




2448




 





 





 





 





 





 



     my %uroutine_arg_exprs 




2449




 





 





 





 





 





 



         = map { ($_->get_attribute( 'call_uroutine_arg' )->get_self_id() => $_) } 




2450




 





 





 





 





 





 



           @{$rtn_stmt_node->get_child_nodes( 'routine_expr' )}; 




2451




 





 





 





 





 





 



     # Note: The build_expr() calls are done below to ensure the arg values are 




2452




 





 





 





 





 





 



     # defined in the same order they are output; this lets optional insertion 




2453




 





 





 





 





 





 



     # of positionally determined host params (and their mapping) to work right. 




2454




 





 





 





 





 





 



     my $arg_val_list = join q{, }, 




2455




 





 





 





 





 





 



         map { $uroutine_arg_exprs{$_->get_self_id()} 




2456




 





 





 





 





 





 



               ? $builder->build_expr( $uroutine_arg_exprs{$_->get_self_id()} ) 




2457




 





 





 





 





 





 



               : 'NULL' } 




2458




 





 





 





 





 





 



         @{$uroutine->get_child_nodes( 'routine_arg' )}; 




2459




 





 





 





 





 





 



     #  ::= CALL  




2460




 





 





 





 





 





 



     return 'CALL ' . $uroutine_name . ($arg_val_list ? '(' . $arg_val_list . ')' : $EMPTY_STR) . ';' . "\n"; 




2461




 





 





 





 





 





 



 } 




2462




 





 





 





 





 





 



   




2463




 





 





 





 





 





 



 ###################################################################### 




2464




 





 





 





 





 





 



   




2465




 





 





 





 





 





 



 sub substitute_macros { 




2466




 





 





 





 





 





 



     my ($builder, $str, $subs) = @_; 




2467




 





 





 





 





 





 



     while (my ($key,$value) = each %{$subs}) { 




2468




 





 





 





 





 





 



         $str =~ s/ \{ $key \} /$value/x; 




2469




 





 





 





 





 





 



     } 




2470




 





 





 





 





 





 



     return $str; 




2471




 





 





 





 





 





 



 } 




2472




 





 





 





 





 





 



   




2473




 





 





 





 





 





 



 ###################################################################### 




2474




 





 





 





 





 





 



   




2475




 





 





 





 





 





 



 sub find_scalar_domain_for_row_domain_field { 




2476




 





 





 





 





 





 



     my ($builder, $scalar_data_type_node, $row_domain_node) = @_; 




2477




 





 





 





 





 





 



     my @candidates = grep { $_->get_attribute( 'data_type' )->get_self_id() eq $scalar_data_type_node->get_self_id() } 




2478




 





 





 





 





 





 



         @{$row_domain_node->get_primary_parent_attribute()->get_child_nodes( 'scalar_domain' )}; 




2479




 





 





 





 





 





 



     return $candidates[0] || $scalar_data_type_node; 




2480




 





 





 





 





 





 



 } 




2481




 





 





 





 





 





 



   




2482




 





 





 





 





 





 



 ###################################################################### 




2483




 





 





 





 





 





 



   




2484




 





 





 





 





 





 



 sub _scalar_data_type_of_node { 




2485




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2486




 





 





 





 





 





 



     $atnm ||= 'scalar_data_type'; 




2487




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2488




 





 





 





 





 





 



     if ($dt_or_dom_node->get_node_type() eq 'scalar_domain') { 




2489




 





 





 





 





 





 



         $dt_or_dom_node = $dt_or_dom_node->get_attribute( 'data_type' ); 




2490




 





 





 





 





 





 



     } 




2491




 





 





 





 





 





 



     return $dt_or_dom_node; 




2492




 





 





 





 





 





 



 } 




2493




 





 





 





 





 





 



   




2494




 





 





 





 





 





 



 sub _row_data_type_of_node { 




2495




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2496




 





 





 





 





 





 



     $atnm ||= 'row_data_type'; 




2497




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2498




 





 





 





 





 





 



     if ($dt_or_dom_node->get_node_type() eq 'row_domain') { 




2499




 





 





 





 





 





 



         $dt_or_dom_node = $dt_or_dom_node->get_attribute( 'data_type' ); 




2500




 





 





 





 





 





 



     } 




2501




 





 





 





 





 





 



     return $dt_or_dom_node; 




2502




 





 





 





 





 





 



 } 




2503




 





 





 





 





 





 



   




2504




 





 





 





 





 





 



 sub _row_domain_of_node { 




2505




 





 





 





 





 





 



     # returns domain or nothing 




2506




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2507




 





 





 





 





 





 



     $atnm ||= 'row_data_type'; 




2508




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2509




 





 





 





 





 





 



     return $dt_or_dom_node 




2510




 





 





 





 





 





 



         if $dt_or_dom_node->get_node_type() eq 'row_domain'; 




2511




 





 





 





 





 





 



     return; 




2512




 





 





 





 





 





 



 } 




2513




 





 





 





 





 





 



   




2514




 





 





 





 





 





 



 ###################################################################### 




2515




 





 





 





 





 





 



 # This is a 'protected' method; only sub-classes should invoke it. 




2516




 





 





 





 





 





 



   




2517




 





 





 





 





 





 



 sub _throw_error_message { 




2518




 





 





 





 





 





 



     my ($builder, $msg_key, $msg_vars) = @_; 




2519




 





 





 





 





 





 



     # Throws an exception consisting of an object. 




2520




 





 





 





 





 





 



     ref $msg_vars eq 'HASH' or $msg_vars = {}; 




2521




 





 





 





 





 





 



     for my $var_key (keys %{$msg_vars}) { 




2522




 





 





 





 





 





 



         if (ref $msg_vars->{$var_key} eq 'ARRAY') { 




2523




 





 





 





 





 





 



             $msg_vars->{$var_key} = 'PERL_ARRAY:[' . (join q{,},map {$_||$EMPTY_STR} @{$msg_vars->{$var_key}}) . ']'; 




2524




 





 





 





 





 





 



         } 




2525




 





 





 





 





 





 



     } 




2526




 





 





 





 





 





 



     die Locale::KeyedText->new_message( $msg_key, $msg_vars ); 




2527




 





 





 





 





 





 



 } 




2528




 





 





 





 





 





 



   




2529




 





 





 





 





 





 



 sub _assert_arg_node_type { 




2530




 





 





 





 





 





 



     my ($builder, $meth_name, $arg_name, $exp_node_types, $arg_value) = @_; 




2531




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_UNDEF', 




2532




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name } ) 




2533




 





 





 





 





 





 



         if !defined $arg_value; 




2534




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_NO_NODE', 




2535




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name, 'ARGVL' => $arg_value } ) 




2536




 





 





 





 





 





 



         if !ref $arg_value or !UNIVERSAL::isa( $arg_value, 'Rosetta::Model::Node' ); 




2537




 





 





 





 





 





 



     return 




2538




 





 





 





 





 





 



         if @{$exp_node_types} == 0; # any Node type is acceptable 




2539




 





 





 





 





 





 



     my $given_node_type = $arg_value->get_node_type(); 




2540




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_WRONG_NODE_TYPE', 




2541




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name, 




2542




 





 





 





 





 





 



         'EXPNTYPE' => $exp_node_types, 'ARGNTYPE' => $given_node_type } ) 




2543




 





 





 





 





 





 



         if !grep { $given_node_type eq $_ } @{$exp_node_types}; 




2544




 





 





 





 





 





 



     # If we get here, $arg_value is acceptable to the method. 




2545




 





 





 





 





 





 



 } 




2546




 





 





 





 





 





 



   




2547




 





 





 





 





 





 



 ###################################################################### 




2548




 





 





 





 





 





 



 ###################################################################### 




2549




 





 





 





 





 





 



   




2550




 





 





 





 





 





 



 1; 




2551




 





 





 





 





 





 



 __END__
    # SQL:2003, 11.7 "" (p547)
    # SQL:2003, 11.8 "" (p549)
    # TODO: SQL:2003, 11.9 "" (p569)
    # TODO: "GENERATED ALWAYS AS ..." which looks like FileMaker's (etc) "calculation" field types.
    my ($builder, $table_node) = @_;
    $builder->_assert_arg_node_type( 'build_schema_or_app_table_create',
        'TABLE_NODE', ['table'], $table_node );
    my $table_name = $builder->build_identifier_schema_or_app_obj( $table_node, 1 );
    my @table_field_sql = ();
    my %col_name_cache = (); # used when making ind defs
    my %mandatory_field_cache = (); # used when making ind defs
    my %table_fields_by_row_field = map { ($_->get_attribute( 'si_row_field' )->get_self_id() => $_) }
        @{$table_node->get_child_nodes( 'table_field' )};
    my $row_data_type_node = $builder->_row_data_type_of_node( $table_node ); # is always set
    my $row_domain_node = $builder->_row_domain_of_node( $table_node ); # may be undefined
    for my $row_field_node (@{$row_data_type_node->get_child_nodes( 'row_data_type_field' )}) {
        my $table_field_name = $builder->build_identifier_element( $row_field_node );
        if (!exists $col_name_cache{$row_field_node->get_self_id()}) {
            $col_name_cache{$row_field_node->get_self_id()} = $table_field_name;
        }
        my $scalar_data_type_node = $row_field_node->get_attribute( 'scalar_data_type' );
        my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name(
            $row_domain_node ? $builder->find_scalar_domain_for_row_domain_field(
            $scalar_data_type_node, $row_domain_node ) : $scalar_data_type_node );
        my $table_field_sql_item = $table_field_name . ' ' . $dt_or_dom_sql;
        if (my $table_field_node = $table_fields_by_row_field{$row_field_node->get_self_id()}) {
            my $mandatory = $table_field_node->get_attribute( 'mandatory' );
            $mandatory and $mandatory_field_cache{$row_field_node->get_self_id()} = 1;
            my $default_val = $table_field_node->get_attribute( 'default_val' );
            my $auto_inc = $table_field_node->get_attribute( 'auto_inc' );
            my $default_seq_node = $table_field_node->get_attribute( 'default_seq' );
            $table_field_sql_item .= ($mandatory ? ' NOT NULL' : ' NULL')
                . (defined $default_val ? ' DEFAULT ' . $builder->quote_literal(
                    $default_val, $scalar_data_type_node->get_attribute( 'base_type' ) ) : $EMPTY_STR)
                . ($auto_inc ? ' AUTO_INCREMENT' : $EMPTY_STR)
                . ($default_seq_node ? ' DEFAULT '
                    . $builder->build_expr_seq_next( $default_seq_node ) : $EMPTY_STR);
        }
        else {
            $table_field_sql_item .= ' NULL';
        }
        push @table_field_sql, $table_field_sql_item;
    }
    my @table_index_sql = ();
    my $pk_is_made = 0;
    for my $table_index_node (@{$table_node->get_child_nodes( 'table_index' )}) {
        my $table_index_name = $builder->build_identifier_element( $table_index_node );
        my $index_type = $table_index_node->get_attribute( 'index_type' );
        my @table_index_field_nodes = @{$table_index_node->get_child_nodes( 'table_index_field' )};
        my $local_field_names_sql = join q{, }, map {
                $col_name_cache{$_->get_attribute( 'si_field' )->get_self_id()}
            } @table_index_field_nodes;
        if ($index_type eq 'ATOMIC') {
            push @table_index_sql, 'INDEX ' . $table_index_name . ' (' . $local_field_names_sql . ')';
        }
        if ($index_type eq 'FULLTEXT') {
            push @table_index_sql, 'FULLTEXT INDEX ' . $table_index_name . ' (' . $local_field_names_sql . ')';
        }
        if ($index_type eq 'UNIQUE' or $index_type eq 'UFOREIGN') {
            my $make_a_pk_now = 0;
            if (!$pk_is_made) {
                # All component columns of a primary key must be mandatory; check for it.
                $make_a_pk_now = all {
                        $mandatory_field_cache{ $_->get_attribute( 'si_field' )->get_self_id() }
                    } @table_index_field_nodes;
            }
            if ($make_a_pk_now) {
                push @table_index_sql, 'CONSTRAINT PRIMARY KEY (' . $local_field_names_sql . ')';
            }
            else {
                push @table_index_sql, 'CONSTRAINT ' . $table_index_name . ' UNIQUE'
                    . ' (' . $local_field_names_sql . ')'; # standard does not say INDEX after UNIQUE
            }
        }
        if ($index_type eq 'FOREIGN' or $index_type eq 'UFOREIGN') {
            my $foreign_table_name = $builder->build_identifier_schema_or_app_obj(
                $table_index_node->get_attribute( 'f_table' ) );
            my $foreign_field_names_sql = join q{, }, map {
                    $builder->build_identifier_element( $_->get_attribute( 'f_field' ) )
                } @table_index_field_nodes;
            push @table_index_sql, 'CONSTRAINT ' . $table_index_name . ' FOREIGN KEY'
                . ' (' . $local_field_names_sql . ') REFERENCES ' . $foreign_table_name
                . ' (' . $foreign_field_names_sql . ')';
        }
    }
    my $is_temp = ($table_node->get_primary_parent_attribute()->get_node_type() eq 'application');
    return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' TABLE ' . $table_name
           . ' (' . "\n" . (join q{, } . "\n", @table_field_sql, @table_index_sql) . "\n" . ');' . "\n";
}

sub build_schema_or_app_table_delete { # SQL:2003, 11.21 "" (p587)
    my ($builder, $table_node) = @_;
    $builder->_assert_arg_node_type( 'build_schema_or_app_table_delete',
        'TABLE_NODE', ['table'], $table_node );
    my $table_name = $builder->build_identifier_schema_or_app_obj( $table_node, 1 );
    return 'DROP TABLE ' . $table_name . ';' . "\n";
}

######################################################################

sub build_schema_or_app_view_create { # SQL:2003, 11.22 "" (p590)
    my ($builder, $view_node) = @_;
    $builder->_assert_arg_node_type( 'build_schema_or_app_view_create',
        'VIEW_NODE', ['view'], $view_node );
    my $view_name = $builder->build_identifier_schema_or_app_obj( $view_node, 1 );
    my $query_expression = $builder->build_query_query_expr( $view_node );
    my $is_temp = ($view_node->get_primary_parent_attribute()->get_node_type() eq 'application');
    return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' VIEW ' . $view_name . ' AS ' . $query_expression . ';' . "\n";
    # Note: Several interesting looking features are not implemented yet.
}

sub build_schema_or_app_view_delete { # SQL:2003, 11.23 "" (p600)
    my ($builder, $view_node) = @_;
    $builder->_assert_arg_node_type( 'build_schema_or_app_view_delete',
        'VIEW_NODE', ['view'], $view_node );
    my $view_name = $builder->build_identifier_schema_or_app_obj( $view_node, 1 );
    return 'DROP VIEW ' . $view_name . ';' . "\n";
}

######################################################################

sub build_schema_or_app_routine_create {
    # SQL:2003, 11.39 "" (p629)
    # SQL:2003, 11.50 "" (p675)
    my ($builder, $routine_node) = @_;
    $builder->_assert_arg_node_type( 'build_schema_or_app_routine_create',
        'ROUTINE_NODE', ['routine'], $routine_node );
    my $routine_type = $routine_node->get_attribute( 'routine_type' );
    my $routine_name = $builder->build_identifier_schema_or_app_obj( $routine_node, 1 );
    my $is_temp = ($routine_node->get_primary_parent_attribute()->get_node_type() eq 'application');
    if ($routine_type eq 'PACKAGE') {
        # Not implemented yet.
    }
    elsif ($routine_type eq 'TRIGGER') {
        my $table_or_view_name = $builder->build_identifier_schema_or_app_obj(
            $routine_node->get_attribute( 'trigger_on' ) );
        my $trigger_event = $routine_node->get_attribute( 'trigger_event' );
        my $trigger_event_sql
            = $trigger_event eq 'BEFR_INS' ? 'BEFORE INSERT'
            : $trigger_event eq 'AFTR_INS' ? 'AFTER INSERT'
            : $trigger_event eq 'INST_INS' ? 'INSTEAD OF INSERT'
            : $trigger_event eq 'BEFR_UPD' ? 'BEFORE UPDATE'
            : $trigger_event eq 'AFTR_UPD' ? 'AFTER UPDATE'
            : $trigger_event eq 'INST_UPD' ? 'INSTEAD OF UPDATE'
            : $trigger_event eq 'BEFR_DEL' ? 'BEFORE DELETE'
            : $trigger_event eq 'AFTR_DEL' ? 'AFTER DELETE'
            : $trigger_event eq 'INST_DEL' ? 'INSTEAD OF DELETE'
            :                                undef # we should never get here
            ;
            # Note: INSTEAD OF is not standard SQL, but supported by SQLServer 2000, maybe Oracle, ?.
        my $for_each_stmt = $routine_node->get_attribute( 'trigger_per_stmt' );
        # TODO: Implement optional OF .
        my @transition_var_names = (); # TODO: NEW/OLD ROW AS <... variable name>
        my $triggered_sql_statement = $builder->build_dmanip_routine_body( $routine_node, 1 );
        return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' TRIGGER ' . $routine_name . ' '
            . $trigger_event_sql . ' ON ' . $table_or_view_name
            . (@transition_var_names ? ' REFERENCING ' . (join ' ', @transition_var_names) : $EMPTY_STR)
            . ($for_each_stmt ? ' FOR EACH STATEMENT' : ' FOR EACH ROW')
            # TODO: WHEN (  )
            . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR)
            . $triggered_sql_statement
            . ';' . "\n";
    }
    elsif ($routine_type eq 'PROCEDURE') {
        my $routine_args = $builder->build_dmanip_routine_args( $routine_node );
        # TODO:  where appropriate.
        my $routine_body = $builder->build_dmanip_routine_body( $routine_node );
        return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' PROCEDURE ' . $routine_name
            . $routine_args
            . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR)
            . ' ' . $routine_body . ';' . "\n";
    }
    elsif ($routine_type eq 'FUNCTION') {
        my $routine_args = $builder->build_dmanip_routine_args( $routine_node );
        # TODO:  where appropriate.
        my $routine_body = $builder->build_dmanip_routine_body( $routine_node );
        my $return_cont_type = $routine_node->get_attribute( 'return_cont_type' );
        my $return_data_type = $EMPTY_STR;
        if ($return_cont_type eq 'ERROR') {
            # Not implemented yet.
        }
        elsif ($return_cont_type eq 'SCALAR') {
            my $dt_or_dom_node = $routine_node->get_attribute( 'return_scalar_data_type' );
            my $return_data_type = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node );
        }
        elsif ($return_cont_type eq 'ROW') {
            my $dt_or_dom_node = $routine_node->get_attribute( 'return_row_data_type' );
            my $return_data_type = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node );
        }
        elsif ($return_cont_type eq 'SC_ARY') {
            my $dt_or_dom_node = $routine_node->get_attribute( 'return_scalar_data_type' );
            my $return_data_type = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node ) . ' ARRAY';
        }
        elsif ($return_cont_type eq 'RW_ARY') {
            my $dt_or_dom_node = $routine_node->get_attribute( 'return_row_data_type' );
            my $return_data_type = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node ) . ' ARRAY';
        }
        elsif ($return_cont_type eq 'CONN') {
            # Not implemented yet.
        }
        elsif ($return_cont_type eq 'CURSOR') {
            # Not implemented yet.
        }
        elsif ($return_cont_type eq 'LIST') {
            # Not implemented yet.
        }
        else {}
        return 'CREATE' . ($is_temp ? ' TEMPORARY' : $EMPTY_STR) . ' FUNCTION ' . $routine_name
            . $routine_args
            . ' RETURNS ' . $return_data_type
            . ($builder->{$PROP_ORA_ROUTINES} ? 'AS ' : $EMPTY_STR)
            . ' ' . $routine_body . ';' . "\n";
    }
    else {} # $routine_type eq 'BLOCK'
        # 'BLOCK': no-op; you should call build_dmanip_routine_body() directly instead
}

sub build_schema_or_app_routine_delete {
    # SQL:2003, 11.40 "" (p633)
    # SQL:2003, 11.52 "" (p703)
    my ($builder, $routine_node) = @_;
    $builder->_assert_arg_node_type( 'build_schema_or_app_routine_delete',
        'ROUTINE_NODE', ['routine'], $routine_node );
    my $routine_type = $routine_node->get_attribute( 'routine_type' );
    my $routine_name = $builder->build_identifier_schema_or_app_obj( $routine_node, 1 );
    # Note: 10.6 "" (p499) may be useful later.
    if ($routine_type eq 'PACKAGE') {
        # Not implemented yet.
    }
    elsif ($routine_type eq 'TRIGGER') {
        return 'DROP TRIGGER ' . $routine_name . ';' . "\n";
    }
    elsif ($routine_type eq 'PROCEDURE') {
        return 'DROP PROCEDURE ' . $routine_name . ';' . "\n";
    }
    elsif ($routine_type eq 'FUNCTION') {
        return 'DROP FUNCTION ' . $routine_name . ';' . "\n";
    }
    else {} # $routine_type eq 'BLOCK'; no-op
}

######################################################################

sub build_access_role_create { # SQL:2003, 12.4 "" (p743)
    my ($builder, $role_node) = @_;
    $builder->_assert_arg_node_type( 'build_access_role_create',
        'ROLE_NODE', ['role'], $role_node );
    my $role_name = $builder->build_identifier_element( $role_node );
    return 'CREATE ROLE ' . $role_name . ';' . "\n";
}

sub build_access_role_delete { # SQL:2003, 12.6 "" (p746)
    my ($builder, $role_node) = @_;
    $builder->_assert_arg_node_type( 'build_access_role_delete',
        'ROLE_NODE', ['role'], $role_node );
    my $role_name = $builder->build_identifier_element( $role_node );
    return 'DROP ROLE ' . $role_name . ';' . "\n";
}

######################################################################

sub build_access_grant {
    # Function returns empty string if given grantee has no privileges.
    # SQL:2003, 12.1 "" (p731)
    # SQL:2003, 12.2 "" (p736)
    # SQL:2003, 12.3 "" (p739)
    # SQL:2003, 12.5 "" (p744)
    my ($builder, $grantee_node) = @_;
    $builder->_assert_arg_node_type( 'build_access_grant',
        'GRANTEE_NODE', ['role','user'], $grantee_node );
    my $node_type = $grantee_node->get_node_type();
    my $grantee_name = $builder->build_identifier_schema_or_app_obj( $grantee_node );
    if ($node_type eq 'role') {
        my @grant_stmts = ();
        for my $priv_on_node (@{$grantee_node->get_child_nodes( 'privilege_on' )}) {
            my $object_node = $priv_on_node->get_attribute( 'si_priv_on' );
            my $object_name = $builder->build_identifier_schema_or_app_obj( $object_node );
            my @priv_types = map { $_->get_attribute( 'si_priv_type' ) }
                @{$priv_on_node->get_child_nodes( 'privilege_for' )};
            my @object_privs = ();
            if (grep { $_ eq 'ALL' } @priv_types) {
                push @object_privs, 'ALL PRIVILEGES';
            }
            else {
                for my $priv_type (@priv_types) {
                    push @object_privs,
                           $priv_type eq 'SELECT' ? 'SELECT' # TODO: allow only specific columns
                         : $priv_type eq 'DELETE' ? 'DELETE'
                         : $priv_type eq 'INSERT' ? 'INSERT' # TODO: allow only specific columns
                         : $priv_type eq 'UPDATE' ? 'UPDATE' # TODO: allow only specific columns
                         :                          $EMPTY_STR # TODO: REFERENCES, USAGE, TRIGGER, UNDER, EXECUTE; what do they mean?
                         ;
                }
            }
            push @grant_stmts, 'GRANT ' . (join q{, }, @object_privs)
                . ' ON ' . $object_name . ' TO ' . $grantee_name . ';';
        }
        return join $EMPTY_STR, @grant_stmts;
    }
    elsif ($node_type eq 'user') {
        my @role_names = map { $builder->build_identifier_schema_or_app_obj( $_ ) }
            @{$grantee_node->get_child_nodes( 'user_role' )};
        return @role_names ? 'GRANT ' . (join q{, }, @role_names) . ' TO ' . $grantee_name . ';' : $EMPTY_STR;
    }
    else {}
}

sub build_access_revoke {
    # SQL:2003, 12.7 "" (p747)
    # SQL:2003, 12.3 "" (p739)
    my ($builder, $grantee_node) = @_;
    $builder->_assert_arg_node_type( 'build_access_revoke',
        'GRANTEE_NODE', ['role','user'], $grantee_node );
    my $node_type = $grantee_node->get_node_type();
    my $grantee_name = $builder->build_identifier_schema_or_app_obj( $grantee_node );
    if ($node_type eq 'role') {
        my @revoke_stmts = ();
        for my $priv_on_node (@{$grantee_node->get_child_nodes( 'privilege_on' )}) {
            my $object_node = $priv_on_node->get_attribute( 'si_priv_on' );
            my $object_name = $builder->build_identifier_schema_or_app_obj( $object_node );
            push @revoke_stmts, 'REVOKE ALL PRIVILEGES'
                . ' ON ' . $object_name . ' FROM ' . $grantee_name . ';';
        }
        return join $EMPTY_STR, @revoke_stmts;
    }
    elsif ($node_type eq 'user') {
        my @role_names = map { $builder->build_identifier_schema_or_app_obj( $_ ) }
            @{$grantee_node->get_child_nodes( 'user_role' )};
        return @role_names ? 'REVOKE ' . (join q{, }, @role_names) . ' FROM ' . $grantee_name . ';' : $EMPTY_STR;
    }
    else {}
}

######################################################################

sub build_dmanip_routine_args {
    my ($builder, $routine_node) = @_;
    $builder->_assert_arg_node_type( 'build_dmanip_routine_args',
        'ROUTINE_NODE', ['routine'], $routine_node );
    # SQL:2003, 11.50 "" (p675)
    # in particular see
    my @rtn_arg_declare_sql = ();
    for my $rtn_arg_node (@{$routine_node->get_child_nodes( 'routine_arg' )}) {
        # TODO:  ::= IN | OUT | INOUT
        my $arg_name = $builder->build_identifier_element( $rtn_arg_node );
        my $cont_type = $rtn_arg_node->get_attribute( 'cont_type' );
        if ($cont_type eq 'ERROR') {
            # Not implemented yet.
        }
        elsif ($cont_type eq 'SCALAR') {
            my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'scalar_data_type' );
            my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node );
            push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ';';
        }
        elsif ($cont_type eq 'ROW') {
            my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'row_data_type' );
            my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node );
            push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ';';
        }
        elsif ($cont_type eq 'SC_ARY') {
            my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'scalar_data_type' );
            my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node );
            push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ' ARRAY;';
        }
        elsif ($cont_type eq 'RW_ARY') {
            my $dt_or_dom_node = $rtn_arg_node->get_attribute( 'row_data_type' );
            my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node );
            push @rtn_arg_declare_sql, $arg_name . ' ' . $dt_or_dom_sql . ' ARRAY;';
        }
        elsif ($cont_type eq 'CONN') {
            # Not implemented yet.
        }
        elsif ($cont_type eq 'CURSOR') {
            # Not implemented yet.
        }
        elsif ($cont_type eq 'LIST') {
            # Not implemented yet.
        }
        else {}
    }
    return @rtn_arg_declare_sql ? '(' . (join q{, }, @rtn_arg_declare_sql) . ')' : $EMPTY_STR;
}

sub build_dmanip_routine_body {
    # Corresponds to these sections:
    # ?
    # SQL:2003, 6.1 "" (p161)
    # SQL:2003, 13.5 "" (p790)
    # SQL:2003, 14.1 "" (p809)
    my ($builder, $routine_node, $is_atomic) = @_;
    $builder->_assert_arg_node_type( 'build_dmanip_routine_body',
        'ROUTINE_NODE', ['routine'], $routine_node );
    my $is_ora_routines = $builder->{$PROP_ORA_ROUTINES};
    my @rtn_var_declare_sql = ();
    for my $rtn_var_node (@{$routine_node->get_child_nodes( 'routine_var' )}) {
        my $var_name = $builder->build_identifier_element( $rtn_var_node );
        my $cont_type = $rtn_var_node->get_attribute( 'cont_type' );
        if ($cont_type eq 'ERROR') {
            # Not implemented yet.
        }
        elsif ($cont_type eq 'SCALAR') {
            my $dt_or_dom_node = $rtn_var_node->get_attribute( 'scalar_data_type' );
            my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node );
            my $init_lit_val = $rtn_var_node->get_attribute( 'init_lit_val' );
            my $is_constant = $rtn_var_node->get_attribute( 'is_constant' );
            push @rtn_var_declare_sql,
                ($is_ora_routines ? $EMPTY_STR : 'DECLARE ')
                . $var_name . ' ' . $dt_or_dom_sql
                # TODO: use $is_constant
                . (defined $init_lit_val ? ' DEFAULT ' . $builder->quote_literal( $init_lit_val,
                    $builder->_scalar_data_type_of_node( $rtn_var_node )->get_attribute( 'base_type' ) ) : $EMPTY_STR)
                . ';'
            ;
        }
        elsif ($cont_type eq 'ROW') {
            my $dt_or_dom_node = $rtn_var_node->get_attribute( 'row_data_type' );
            my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node );
            push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ';';
        }
        elsif ($cont_type eq 'SC_ARY') {
            my $dt_or_dom_node = $rtn_var_node->get_attribute( 'scalar_data_type' );
            my $dt_or_dom_sql = $builder->build_expr_scalar_data_type_or_domain_name( $dt_or_dom_node );
            push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ' ARRAY;';
        }
        elsif ($cont_type eq 'RW_ARY') {
            my $dt_or_dom_node = $rtn_var_node->get_attribute( 'row_data_type' );
            my $dt_or_dom_sql = $builder->build_expr_row_data_type_or_domain_name( $dt_or_dom_node );
            push @rtn_var_declare_sql, ($is_ora_routines ? $EMPTY_STR : 'DECLARE ') . $var_name . ' ' . $dt_or_dom_sql . ' ARRAY;';
        }
        elsif ($cont_type eq 'CONN') {
            # Not implemented yet.
        }
        elsif ($cont_type eq 'CURSOR') {
            if (my $view_node = (@{$rtn_var_node->get_child_nodes( 'view' )})[0]) {
                # Since we got here, cursor will be defined within curr rtn, regardless of share or not.
                my $query_expr = $builder->build_query_query_expr( $view_node );
                my $order_by_clause = $builder->build_query_window_clause( $view_node );
                my $updatability_clause
                    = $rtn_var_node->get_attribute( 'curs_for_update' ) ? 'FOR UPDATE'
                    :                                                     'FOR READ ONLY'; # TODO: [ OF  ]
                # TODO: sensitivity, scrollability, holdability, returnability
                my $cursor_spec = $query_expr . ' ' . $order_by_clause . ' ' . $updatability_clause;
                push @rtn_var_declare_sql, 'DECLARE ' . $var_name . ' CURSOR FOR ' . $cursor_spec . ';';
            }
            else {
                # Not implemented yet; but also not sure of proper way to implement.
                # If we got here then cursor had been declared in diff rtn and passed to curr one.
                # We can't just make another copy of decl since may use vars/args/etc of other rtn.
                push @rtn_var_declare_sql, 'DECLARE ' . $var_name . ';';
            }
        }
        elsif ($cont_type eq 'LIST') {
            # Not implemented yet.
        }
        else {}
    }
    my @rtn_stmt_sql = ();
    for my $rtn_stmt_node (@{$routine_node->get_child_nodes( 'routine_stmt' )}) {
        push @rtn_stmt_sql, $builder->build_dmanip_routine_stmt( $rtn_stmt_node );
    }
    my $atomic_clause = $is_atomic ? 'ATOMIC ' : $EMPTY_STR;
    return join ' ',
        # TODO: proper handling of vars declared within 'BLOCK' routines, when in Oracle syntax.
        ($is_ora_routines ? 'VAR ' : 'BEGIN ' . $atomic_clause),
        @rtn_var_declare_sql,
        ($is_ora_routines ? 'BEGIN ' . $atomic_clause : $EMPTY_STR),
        @rtn_stmt_sql,
        'END;'
    ;
}

######################################################################

sub build_dmanip_routine_stmt {
    # SQL:2003, 13.5 "" (p790)
    my ($builder, $rtn_stmt_node) = @_;
    $builder->_assert_arg_node_type( 'build_dmanip_routine_stmt',
        'STMT_NODE', ['routine_stmt'], $rtn_stmt_node );
    if (my $compound_stmt_routine = $rtn_stmt_node->get_attribute( 'block_routine' )) {
        return $builder->build_dmanip_routine_body( $compound_stmt_routine );
    }
    elsif (my $assign_dest_node = $rtn_stmt_node->get_attribute( 'assign_dest' ) ||
            $rtn_stmt_node->get_attribute( 'assign_dest' )) {
        my $dest = $builder->build_identifier_element( $assign_dest_node );
        my $src = $builder->build_expr(
            $rtn_stmt_node->get_child_nodes( 'routine_expr' )->[0] );
        if ($builder->{$PROP_ORA_ROUTINES}) {
            return $dest . ' := ' . $src . ';' . "\n";
        }
        else {
            return 'SET ' . $dest . ' = ' . $src . ';' . "\n";
        }
    }
    elsif ($rtn_stmt_node->get_attribute( 'call_sroutine' )) {
        return $builder->build_dmanip_call_sroutine( $rtn_stmt_node );
    }
    elsif ($rtn_stmt_node->get_attribute( 'call_uroutine' )) {
        return $builder->build_dmanip_call_uroutine( $rtn_stmt_node );
    }
    else {}
}

######################################################################

sub build_dmanip_call_sroutine {
    # Corresponds to these sections:
    # SQL:2003, 14.2 "" (p815)
    # SQL:2003, 14.3 "" (p817)
    # SQL:2003, 14.4 "" (p822)
    # SQL:2003, 15.2 "" (p886)
    my ($builder, $rtn_stmt_node) = @_;
    $builder->_assert_arg_node_type( 'build_dmanip_call_sroutine',
        'STMT_NODE', ['routine_stmt'], $rtn_stmt_node );
    my $sroutine = $rtn_stmt_node->get_attribute( 'call_sroutine' );
    my %child_exprs = map { (
            ($_->get_attribute( 'call_sroutine_cxt' ) ||
                $_->get_attribute( 'call_sroutine_arg' )) => $_
        ) } @{$rtn_stmt_node->get_child_nodes( 'routine_expr' )};
    if ($sroutine eq 'RETURN') {
        my $return_value = $builder->build_expr( $child_exprs{'RETURN_VALUE'} );
        return 'RETURN ' . $return_value . ';' . "\n"; # no parens in standard
    }
    elsif ($sroutine eq 'CURSOR_OPEN') { # opens a select cursor for reading from (or performs a select if in right context)
        my $cursor_cx_name = $builder->build_identifier_element(
            $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) );
        return 'OPEN ' . $cursor_cx_name . ';' . "\n";
    }
    elsif ($sroutine eq 'CURSOR_CLOSE') { # closes a select cursor when you're done with it
        my $cursor_cx_name = $builder->build_identifier_element(
            $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) );
        return 'CLOSE ' . $cursor_cx_name . ';' . "\n";
    }
    elsif ($sroutine eq 'CURSOR_FETCH') { # reads a row from an opened cursor and puts it in a row/list variable
        my $cursor_cx_name = $builder->build_identifier_element(
            $child_exprs{'CURSOR_CX'}->get_attribute( 'valf_p_routine_item' ) );
        my $fetch_orient = $EMPTY_STR; # TODO: the explicit  options; NEXT is default
        my $query_dest_name = $builder->build_identifier_element(
            $child_exprs{'INTO'}->get_attribute( 'query_dest' ) );
        return 'FETCH ' . $fetch_orient . ' FROM ' . $cursor_cx_name . ' INTO ' . $query_dest_name . ';' . "\n";
    }
    elsif ($sroutine eq 'SELECT') { # fetches one row from a table/view and puts it in a row/list variable
        my $view_node = $child_exprs{'SELECT_DEFN'}->get_attribute( 'act_on' );
        return $builder->build_query_query_spec( $view_node,
            $child_exprs{'INTO'}->get_attribute( 'query_dest' ) ) . ';' . "\n";
    }
    elsif ($sroutine eq 'INSERT') { # inserts a row into a table/view
        my $view_node = $child_exprs{'INSERT_DEFN'}->get_attribute( 'act_on' );
        return $builder->build_dmanip_insert_stmt( $view_node );
    }
    elsif ($sroutine eq 'UPDATE') { # updates a row in a table/view
        my $view_node = $child_exprs{'UPDATE_DEFN'}->get_attribute( 'act_on' );
        return $builder->build_dmanip_update_stmt( $view_node );
    }
    elsif ($sroutine eq 'DELETE') { # deletes a row in a table/view
        my $view_node = $child_exprs{'DELETE_DEFN'}->get_attribute( 'act_on' );
        return $builder->build_dmanip_delete_stmt( $view_node );
    }
    elsif ($sroutine eq 'COMMIT') { # commits the current transaction, then starts a new one
        return 'COMMIT; START TRANSACTION;' . "\n";
        # Note: According to the MySQL manual:
        # For transaction-safe tables, there are actions (other than typing COMMIT)
        # that will automatically trigger a COMMIT. Requesting a lock will implicitly
        # commit any outstanding queries.
    }
    elsif ($sroutine eq 'ROLLBACK') { # rolls back the current transaction, then starts a new one
        return 'ROLLBACK; START TRANSACTION;' . "\n"; # TODO: rollback to a named save point only
    }
    else {} # There are a bunch more that aren't implemented yet.
}

######################################################################

sub build_dmanip_src_schema_object_name {
    my ($builder, $view_node) = @_;
    $builder->_assert_arg_node_type( 'build_dmanip_src_schema_object_name',
        'VIEW_NODE', ['view'], $view_node );
    my $view_type = $view_node->get_attribute( 'view_type' );
    my @view_src_nodes = @{$view_node->get_child_nodes( 'view_src' )};
    if (@view_src_nodes == 0) {
        return; # No source at all.
    }
    elsif ($view_type eq 'ALIAS' or @view_src_nodes == 1) {
        my $object_node = $view_src_nodes[0]->get_attribute( 'match' );
        if ($object_node->get_primary_parent_attribute()->get_node_type() eq 'schema') {
            # The only source is a schema object, table or named view; use it directly.
            return $builder->build_identifier_schema_or_app_obj( $object_node );
        }
        else {
            # The only source seems to be a sub-query in "from".
            return; # Adding recursion in all necessary places too complicated for now.
        }
    }
    else { # @view_src_nodes >= 2
        return; # Manual updates against multiple sources too complicated for now.
    }
}

######################################################################

sub build_dmanip_insert_stmt {
    # SQL:2003, 7.3 "" (p298) 




2377




 





 





 





 





 





 



     # SQL:2003, 14.8 "" (p834) 




2378




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2379




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_insert_stmt', 




2380




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2381




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2382




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2383




 





 





 





 





 





 



     my @set_expr_nodes 




2384




 





 





 





 





 





 



         = grep { $_->get_attribute( 'view_part' ) eq 'SET' } 




2385




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




2386




 





 





 





 





 





 



     my @set_fields_list = (); 




2387




 





 





 





 





 





 



     my @set_values_list = (); 




2388




 





 





 





 





 





 



     for my $expr_node (@set_expr_nodes) { 




2389




 





 





 





 





 





 



         push @set_fields_list, $builder->build_identifier_element( 




2390




 





 





 





 





 





 



             $expr_node->get_attribute( 'set_src_field' ) ); 




2391




 





 





 





 





 





 



         push @set_values_list, $builder->build_expr( $expr_node ); 




2392




 





 





 





 





 





 



     } 




2393




 





 





 





 





 





 



     my $insert_fields_and_src = '(' . (join q{, }, @set_fields_list) . ') ' 




2394




 





 





 





 





 





 



         . 'VALUES (' . (join q{, }, @set_values_list) . ')'; 




2395




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2396




 





 





 





 





 





 



     return 'INSERT INTO ' . $object_name . ' ' . $insert_fields_and_src . ';' . "\n"; 




2397




 





 





 





 





 





 



 } 




2398




 





 





 





 





 





 



   




2399




 





 





 





 





 





 



 ###################################################################### 




2400




 





 





 





 





 





 



   




2401




 





 





 





 





 





 



 sub build_dmanip_update_stmt { 




2402




 





 





 





 





 





 



     # SQL:2003, 14.11 "" (p849) 




2403




 





 





 





 





 





 



     # SQL:2003, 14.12 "" (p853) 




2404




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2405




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_update_stmt', 




2406




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2407




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2408




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2409




 





 





 





 





 





 



     my @set_expr_nodes 




2410




 





 





 





 





 





 



         = grep { $_->get_attribute( 'view_part' ) eq 'SET' } 




2411




 





 





 





 





 





 



           @{$view_node->get_child_nodes( 'view_expr' )}; 




2412




 





 





 





 





 





 



     my @set_clause_list = (); 




2413




 





 





 





 





 





 



     for my $expr_node (@set_expr_nodes) { 




2414




 





 





 





 





 





 



         my $set_target = $builder->build_identifier_element( 




2415




 





 





 





 





 





 



             $expr_node->get_attribute( 'set_src_field' ) ); 




2416




 





 





 





 





 





 



         my $update_source = $builder->build_expr( $expr_node ); 




2417




 





 





 





 





 





 



         push @set_clause_list, $set_target . ' = ' . $update_source; 




2418




 





 





 





 





 





 



     } 




2419




 





 





 





 





 





 



     my $set_clause = 'SET ' . (join q{, }, @set_clause_list); 




2420




 





 





 





 





 





 



     my $where_clause = $builder->build_query_where_clause( $view_node ); 




2421




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2422




 





 





 





 





 





 



     return 'UPDATE ' . $object_name . ' ' . $set_clause . ' ' . $where_clause . ';' . "\n"; 




2423




 





 





 





 





 





 



 } 




2424




 





 





 





 





 





 



   




2425




 





 





 





 





 





 



 ###################################################################### 




2426




 





 





 





 





 





 



   




2427




 





 





 





 





 





 



 sub build_dmanip_delete_stmt { # SQL:2003, 14.7 "" (p831) 




2428




 





 





 





 





 





 



     my ($builder, $view_node) = @_; 




2429




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_delete_stmt', 




2430




 





 





 





 





 





 



         'VIEW_NODE', ['view'], $view_node ); 




2431




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 1; 




2432




 





 





 





 





 





 



     my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node ); 




2433




 





 





 





 





 





 



     my $where_clause = $builder->build_query_where_clause( $view_node ); 




2434




 





 





 





 





 





 



     $builder->{$PROP_UNWRAP_VIEWS} = 0; 




2435




 





 





 





 





 





 



     return 'DELETE FROM ' . $object_name . ' ' . $where_clause . ';' . "\n"; 




2436




 





 





 





 





 





 



 } 




2437




 





 





 





 





 





 



   




2438




 





 





 





 





 





 



 ###################################################################### 




2439




 





 





 





 





 





 



   




2440




 





 





 





 





 





 



 sub build_dmanip_call_uroutine { 




2441




 





 





 





 





 





 



     # SQL:2003 ...  ... 




2442




 





 





 





 





 





 



     # SQL:2003, 15.1 "" (p885) 




2443




 





 





 





 





 





 



     my ($builder, $rtn_stmt_node) = @_; 




2444




 





 





 





 





 





 



     $builder->_assert_arg_node_type( 'build_dmanip_call_uroutine', 




2445




 





 





 





 





 





 



         'STMT_NODE', ['routine_stmt'], $rtn_stmt_node ); 




2446




 





 





 





 





 





 



     my $uroutine = $rtn_stmt_node->get_attribute( 'call_uroutine' ); 




2447




 





 





 





 





 





 



     my $uroutine_name = $builder->build_identifier_schema_or_app_obj( $uroutine ); 




2448




 





 





 





 





 





 



     my %uroutine_arg_exprs 




2449




 





 





 





 





 





 



         = map { ($_->get_attribute( 'call_uroutine_arg' )->get_self_id() => $_) } 




2450




 





 





 





 





 





 



           @{$rtn_stmt_node->get_child_nodes( 'routine_expr' )}; 




2451




 





 





 





 





 





 



     # Note: The build_expr() calls are done below to ensure the arg values are 




2452




 





 





 





 





 





 



     # defined in the same order they are output; this lets optional insertion 




2453




 





 





 





 





 





 



     # of positionally determined host params (and their mapping) to work right. 




2454




 





 





 





 





 





 



     my $arg_val_list = join q{, }, 




2455




 





 





 





 





 





 



         map { $uroutine_arg_exprs{$_->get_self_id()} 




2456




 





 





 





 





 





 



               ? $builder->build_expr( $uroutine_arg_exprs{$_->get_self_id()} ) 




2457




 





 





 





 





 





 



               : 'NULL' } 




2458




 





 





 





 





 





 



         @{$uroutine->get_child_nodes( 'routine_arg' )}; 




2459




 





 





 





 





 





 



     #  ::= CALL  




2460




 





 





 





 





 





 



     return 'CALL ' . $uroutine_name . ($arg_val_list ? '(' . $arg_val_list . ')' : $EMPTY_STR) . ';' . "\n"; 




2461




 





 





 





 





 





 



 } 




2462




 





 





 





 





 





 



   




2463




 





 





 





 





 





 



 ###################################################################### 




2464




 





 





 





 





 





 



   




2465




 





 





 





 





 





 



 sub substitute_macros { 




2466




 





 





 





 





 





 



     my ($builder, $str, $subs) = @_; 




2467




 





 





 





 





 





 



     while (my ($key,$value) = each %{$subs}) { 




2468




 





 





 





 





 





 



         $str =~ s/ \{ $key \} /$value/x; 




2469




 





 





 





 





 





 



     } 




2470




 





 





 





 





 





 



     return $str; 




2471




 





 





 





 





 





 



 } 




2472




 





 





 





 





 





 



   




2473




 





 





 





 





 





 



 ###################################################################### 




2474




 





 





 





 





 





 



   




2475




 





 





 





 





 





 



 sub find_scalar_domain_for_row_domain_field { 




2476




 





 





 





 





 





 



     my ($builder, $scalar_data_type_node, $row_domain_node) = @_; 




2477




 





 





 





 





 





 



     my @candidates = grep { $_->get_attribute( 'data_type' )->get_self_id() eq $scalar_data_type_node->get_self_id() } 




2478




 





 





 





 





 





 



         @{$row_domain_node->get_primary_parent_attribute()->get_child_nodes( 'scalar_domain' )}; 




2479




 





 





 





 





 





 



     return $candidates[0] || $scalar_data_type_node; 




2480




 





 





 





 





 





 



 } 




2481




 





 





 





 





 





 



   




2482




 





 





 





 





 





 



 ###################################################################### 




2483




 





 





 





 





 





 



   




2484




 





 





 





 





 





 



 sub _scalar_data_type_of_node { 




2485




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2486




 





 





 





 





 





 



     $atnm ||= 'scalar_data_type'; 




2487




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2488




 





 





 





 





 





 



     if ($dt_or_dom_node->get_node_type() eq 'scalar_domain') { 




2489




 





 





 





 





 





 



         $dt_or_dom_node = $dt_or_dom_node->get_attribute( 'data_type' ); 




2490




 





 





 





 





 





 



     } 




2491




 





 





 





 





 





 



     return $dt_or_dom_node; 




2492




 





 





 





 





 





 



 } 




2493




 





 





 





 





 





 



   




2494




 





 





 





 





 





 



 sub _row_data_type_of_node { 




2495




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2496




 





 





 





 





 





 



     $atnm ||= 'row_data_type'; 




2497




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2498




 





 





 





 





 





 



     if ($dt_or_dom_node->get_node_type() eq 'row_domain') { 




2499




 





 





 





 





 





 



         $dt_or_dom_node = $dt_or_dom_node->get_attribute( 'data_type' ); 




2500




 





 





 





 





 





 



     } 




2501




 





 





 





 





 





 



     return $dt_or_dom_node; 




2502




 





 





 





 





 





 



 } 




2503




 





 





 





 





 





 



   




2504




 





 





 





 





 





 



 sub _row_domain_of_node { 




2505




 





 





 





 





 





 



     # returns domain or nothing 




2506




 





 





 





 





 





 



     my ($builder, $child_node, $atnm) = @_; 




2507




 





 





 





 





 





 



     $atnm ||= 'row_data_type'; 




2508




 





 





 





 





 





 



     my $dt_or_dom_node = $child_node->get_attribute( $atnm ); 




2509




 





 





 





 





 





 



     return $dt_or_dom_node 




2510




 





 





 





 





 





 



         if $dt_or_dom_node->get_node_type() eq 'row_domain'; 




2511




 





 





 





 





 





 



     return; 




2512




 





 





 





 





 





 



 } 




2513




 





 





 





 





 





 



   




2514




 





 





 





 





 





 



 ###################################################################### 




2515




 





 





 





 





 





 



 # This is a 'protected' method; only sub-classes should invoke it. 




2516




 





 





 





 





 





 



   




2517




 





 





 





 





 





 



 sub _throw_error_message { 




2518




 





 





 





 





 





 



     my ($builder, $msg_key, $msg_vars) = @_; 




2519




 





 





 





 





 





 



     # Throws an exception consisting of an object. 




2520




 





 





 





 





 





 



     ref $msg_vars eq 'HASH' or $msg_vars = {}; 




2521




 





 





 





 





 





 



     for my $var_key (keys %{$msg_vars}) { 




2522




 





 





 





 





 





 



         if (ref $msg_vars->{$var_key} eq 'ARRAY') { 




2523




 





 





 





 





 





 



             $msg_vars->{$var_key} = 'PERL_ARRAY:[' . (join q{,},map {$_||$EMPTY_STR} @{$msg_vars->{$var_key}}) . ']'; 




2524




 





 





 





 





 





 



         } 




2525




 





 





 





 





 





 



     } 




2526




 





 





 





 





 





 



     die Locale::KeyedText->new_message( $msg_key, $msg_vars ); 




2527




 





 





 





 





 





 



 } 




2528




 





 





 





 





 





 



   




2529




 





 





 





 





 





 



 sub _assert_arg_node_type { 




2530




 





 





 





 





 





 



     my ($builder, $meth_name, $arg_name, $exp_node_types, $arg_value) = @_; 




2531




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_UNDEF', 




2532




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name } ) 




2533




 





 





 





 





 





 



         if !defined $arg_value; 




2534




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_NO_NODE', 




2535




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name, 'ARGVL' => $arg_value } ) 




2536




 





 





 





 





 





 



         if !ref $arg_value or !UNIVERSAL::isa( $arg_value, 'Rosetta::Model::Node' ); 




2537




 





 





 





 





 





 



     return 




2538




 





 





 





 





 





 



         if @{$exp_node_types} == 0; # any Node type is acceptable 




2539




 





 





 





 





 





 



     my $given_node_type = $arg_value->get_node_type(); 




2540




 





 





 





 





 





 



     $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_WRONG_NODE_TYPE', 




2541




 





 





 





 





 





 



         { 'METH' => $meth_name, 'ARGNM' => $arg_name, 




2542




 





 





 





 





 





 



         'EXPNTYPE' => $exp_node_types, 'ARGNTYPE' => $given_node_type } ) 




2543




 





 





 





 





 





 



         if !grep { $given_node_type eq $_ } @{$exp_node_types}; 




2544




 





 





 





 





 





 



     # If we get here, $arg_value is acceptable to the method. 




2545




 





 





 





 





 





 



 } 




2546




 





 





 





 





 





 



   




2547




 





 





 





 





 





 



 ###################################################################### 




2548




 





 





 





 





 





 



 ###################################################################### 




2549




 





 





 





 





 





 



   




2550




 





 





 





 





 





 



 1; 




2551




 





 





 





 





 





 



 __END__
    # SQL:2003, 14.8 "" (p834)
    my ($builder, $view_node) = @_;
    $builder->_assert_arg_node_type( 'build_dmanip_insert_stmt',
        'VIEW_NODE', ['view'], $view_node );
    $builder->{$PROP_UNWRAP_VIEWS} = 1;
    my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node );
    my @set_expr_nodes
        = grep { $_->get_attribute( 'view_part' ) eq 'SET' }
          @{$view_node->get_child_nodes( 'view_expr' )};
    my @set_fields_list = ();
    my @set_values_list = ();
    for my $expr_node (@set_expr_nodes) {
        push @set_fields_list, $builder->build_identifier_element(
            $expr_node->get_attribute( 'set_src_field' ) );
        push @set_values_list, $builder->build_expr( $expr_node );
    }
    my $insert_fields_and_src = '(' . (join q{, }, @set_fields_list) . ') '
        . 'VALUES (' . (join q{, }, @set_values_list) . ')';
    $builder->{$PROP_UNWRAP_VIEWS} = 0;
    return 'INSERT INTO ' . $object_name . ' ' . $insert_fields_and_src . ';' . "\n";
}

######################################################################

sub build_dmanip_update_stmt {
    # SQL:2003, 14.11 "" (p849)
    # SQL:2003, 14.12 "" (p853)
    my ($builder, $view_node) = @_;
    $builder->_assert_arg_node_type( 'build_dmanip_update_stmt',
        'VIEW_NODE', ['view'], $view_node );
    $builder->{$PROP_UNWRAP_VIEWS} = 1;
    my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node );
    my @set_expr_nodes
        = grep { $_->get_attribute( 'view_part' ) eq 'SET' }
          @{$view_node->get_child_nodes( 'view_expr' )};
    my @set_clause_list = ();
    for my $expr_node (@set_expr_nodes) {
        my $set_target = $builder->build_identifier_element(
            $expr_node->get_attribute( 'set_src_field' ) );
        my $update_source = $builder->build_expr( $expr_node );
        push @set_clause_list, $set_target . ' = ' . $update_source;
    }
    my $set_clause = 'SET ' . (join q{, }, @set_clause_list);
    my $where_clause = $builder->build_query_where_clause( $view_node );
    $builder->{$PROP_UNWRAP_VIEWS} = 0;
    return 'UPDATE ' . $object_name . ' ' . $set_clause . ' ' . $where_clause . ';' . "\n";
}

######################################################################

sub build_dmanip_delete_stmt { # SQL:2003, 14.7 "" (p831)
    my ($builder, $view_node) = @_;
    $builder->_assert_arg_node_type( 'build_dmanip_delete_stmt',
        'VIEW_NODE', ['view'], $view_node );
    $builder->{$PROP_UNWRAP_VIEWS} = 1;
    my $object_name = $builder->build_dmanip_src_schema_object_name( $view_node );
    my $where_clause = $builder->build_query_where_clause( $view_node );
    $builder->{$PROP_UNWRAP_VIEWS} = 0;
    return 'DELETE FROM ' . $object_name . ' ' . $where_clause . ';' . "\n";
}

######################################################################

sub build_dmanip_call_uroutine {
    # SQL:2003 ...  ...
    # SQL:2003, 15.1 "" (p885)
    my ($builder, $rtn_stmt_node) = @_;
    $builder->_assert_arg_node_type( 'build_dmanip_call_uroutine',
        'STMT_NODE', ['routine_stmt'], $rtn_stmt_node );
    my $uroutine = $rtn_stmt_node->get_attribute( 'call_uroutine' );
    my $uroutine_name = $builder->build_identifier_schema_or_app_obj( $uroutine );
    my %uroutine_arg_exprs
        = map { ($_->get_attribute( 'call_uroutine_arg' )->get_self_id() => $_) }
          @{$rtn_stmt_node->get_child_nodes( 'routine_expr' )};
    # Note: The build_expr() calls are done below to ensure the arg values are
    # defined in the same order they are output; this lets optional insertion
    # of positionally determined host params (and their mapping) to work right.
    my $arg_val_list = join q{, },
        map { $uroutine_arg_exprs{$_->get_self_id()}
              ? $builder->build_expr( $uroutine_arg_exprs{$_->get_self_id()} )
              : 'NULL' }
        @{$uroutine->get_child_nodes( 'routine_arg' )};
    #  ::= CALL
    return 'CALL ' . $uroutine_name . ($arg_val_list ? '(' . $arg_val_list . ')' : $EMPTY_STR) . ';' . "\n";
}

######################################################################

sub substitute_macros {
    my ($builder, $str, $subs) = @_;
    while (my ($key,$value) = each %{$subs}) {
        $str =~ s/ \{ $key \} /$value/x;
    }
    return $str;
}

######################################################################

sub find_scalar_domain_for_row_domain_field {
    my ($builder, $scalar_data_type_node, $row_domain_node) = @_;
    my @candidates = grep { $_->get_attribute( 'data_type' )->get_self_id() eq $scalar_data_type_node->get_self_id() }
        @{$row_domain_node->get_primary_parent_attribute()->get_child_nodes( 'scalar_domain' )};
    return $candidates[0] || $scalar_data_type_node;
}

######################################################################

sub _scalar_data_type_of_node {
    my ($builder, $child_node, $atnm) = @_;
    $atnm ||= 'scalar_data_type';
    my $dt_or_dom_node = $child_node->get_attribute( $atnm );
    if ($dt_or_dom_node->get_node_type() eq 'scalar_domain') {
        $dt_or_dom_node = $dt_or_dom_node->get_attribute( 'data_type' );
    }
    return $dt_or_dom_node;
}

sub _row_data_type_of_node {
    my ($builder, $child_node, $atnm) = @_;
    $atnm ||= 'row_data_type';
    my $dt_or_dom_node = $child_node->get_attribute( $atnm );
    if ($dt_or_dom_node->get_node_type() eq 'row_domain') {
        $dt_or_dom_node = $dt_or_dom_node->get_attribute( 'data_type' );
    }
    return $dt_or_dom_node;
}

sub _row_domain_of_node {
    # returns domain or nothing
    my ($builder, $child_node, $atnm) = @_;
    $atnm ||= 'row_data_type';
    my $dt_or_dom_node = $child_node->get_attribute( $atnm );
    return $dt_or_dom_node
        if $dt_or_dom_node->get_node_type() eq 'row_domain';
    return;
}

######################################################################
# This is a 'protected' method; only sub-classes should invoke it.

sub _throw_error_message {
    my ($builder, $msg_key, $msg_vars) = @_;
    # Throws an exception consisting of an object.
    ref $msg_vars eq 'HASH' or $msg_vars = {};
    for my $var_key (keys %{$msg_vars}) {
        if (ref $msg_vars->{$var_key} eq 'ARRAY') {
            $msg_vars->{$var_key} = 'PERL_ARRAY:[' . (join q{,},map {$_||$EMPTY_STR} @{$msg_vars->{$var_key}}) . ']';
        }
    }
    die Locale::KeyedText->new_message( $msg_key, $msg_vars );
}

sub _assert_arg_node_type {
    my ($builder, $meth_name, $arg_name, $exp_node_types, $arg_value) = @_;
    $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_UNDEF',
        { 'METH' => $meth_name, 'ARGNM' => $arg_name } )
        if !defined $arg_value;
    $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_NO_NODE',
        { 'METH' => $meth_name, 'ARGNM' => $arg_name, 'ARGVL' => $arg_value } )
        if !ref $arg_value or !UNIVERSAL::isa( $arg_value, 'Rosetta::Model::Node' );
    return
        if @{$exp_node_types} == 0; # any Node type is acceptable
    my $given_node_type = $arg_value->get_node_type();
    $builder->_throw_error_message( 'ROS_U_SB_METH_ARG_WRONG_NODE_TYPE',
        { 'METH' => $meth_name, 'ARGNM' => $arg_name,
        'EXPNTYPE' => $exp_node_types, 'ARGNTYPE' => $given_node_type } )
        if !grep { $given_node_type eq $_ } @{$exp_node_types};
    # If we get here, $arg_value is acceptable to the method.
}

######################################################################
######################################################################

1;
__END__