Initial Commit

This commit is contained in:
Riley Schneider
2025-12-03 16:38:10 +01:00
parent c5e26bf594
commit b732d8d4b5
17680 changed files with 5977495 additions and 2 deletions

View File

@@ -0,0 +1,322 @@
=pod
=head1 NAME
SQL::Statement::Embed - embed a SQL engine in a DBD or module
=head1 SYNOPSIS
=head1 DESCRIPTION
SQL::Statement is designed to be easy to embed in other modules and to be
especially easy to embed in DBI drivers. It provides a SQL Engine and the
other module needs to then provide a data source and a storage mechanism.
For example, the L<DBD::CSV> module uses SQL::Statement as an embedded SQL
engine by implementing a file-based data source and by using DBI as the
user interface. Similarly L<DBD::Amazon> uses SQL::Statement as its SQL
engine, provides its own extensions to the supported SQL syntax, and uses
on-the-fly searches of Amazon.com as its data source.
SQL::Statement is the basis for at least eight existing DBDs (DBI database
drivers). If you have a new data source, you too can create a DBD without
having to reinvent the SQL wheel. It is fun and easy so become a DBD
author today!
SQL::Statement can be also be embedded without DBI. We will explore that
first since developing a DBD uses most of the same methods and techniques.
=head1 The role of SQL::Statement subclasses
SQL::Statement provides a SQL parsing and execution engine. It neither
provides a data source nor storage mechanism other than in-memory tables.
The L<DBI::DBD::SqlEngine> contains a subclass of SQL::Statement to
abstract from embedding SQL::Statement into a DBD and lets you concentrate
on the extensions you need to make. L<DBD::File> extends DBI::DBD::SqlEngine
by providing access to file-based storage mechanisms. It is quite possible
to use things other than files as data sources, in which case you would not
use L<DBD::File>, instead you would replace L<DBD::File>'s methods with your
own. In the examples below, we use DBD::File, replacing only a few
methods.
SQL::Statement provides SQL parsing and evaluation and DBI::DBD::SqlEngine
provides DBI integration. The only thing missing is a data source - what we
actually want to store and query. As an example suppose we are going to
create a subclass called 'Foo' that will provide as a data source the
in-memory storage which is used in L<SQL::RAM> to provide the C<TEMP>
tables in SQL::Statement, but the rows are stored as a string using a
serializer (Storable).
Consider what needs to happen to perform a SELECT query on our 'Foo' data:
* receive a SQL string
* parse the SQL string into a request structure
* open the table(s) specified in the request
* define column names and positions for the table
* read rows from the table
* convert the rows from colon-separated format into perl arrays
* match the columns and rows against the requested selection criteria
* return requested rows and columns to the user
To perform operations like INSERT and DELETE, we also need to:
* convert rows from perl arrays into colon-separated format
* write rows
* delete rows
SQL::Statement takes care of all of the SQL parsing and evaluation.
DBD::File takes care of file opening, reading, writing, and deleting.
So the only things 'Foo' is really responsible for are:
* define column names and positions for the table
* convert rows from colon-separated format into perl arrays
* convert rows from perl arrays into colon-separated format
In SQL::Statement subclasses these responsibilities are assigned to two
objects. A ::Statement object is responsible for opening the table by
creating new ::Table objects. A ::Table object is responsible for
defining the column names and positions, opening data sources, reading,
converting, writing and deleting data.
The real work is therefore done in the ::Table object, the ::Statement
subclass is required to deliver the right ::Table object.
=head1 Creating a ::Statement object
A subclass of SQL::Statement must provide at least one method called
open_table(). The method should open a new Table object and define the
table's columns. For our 'Foo' module, here is the complete object
definition:
package Foo;
package Foo::Statement;
use DBD::File;
use base qw(DBI::DBD::SqlEngine::Statement);
sub open_table {
my ($self, $sth, $table, $createMode, $lockMode) = @_;
my $class = ref $self;
$class =~ s/::Statement/::Table/;
return $class->new ($sth, $table, $createMode, $lockMode);
}
Since 'Foo' is an in-memory data source, we subclass SQL::Statement
indirectly through DBD::File::Statement. The open_table() method lets
DBD::File do the actual table opening. All we do is define the files
directory (f_dir), the names of the columns (col_names) and the positions
of the columns (col_nums). DBD::File creates and returns a $tbl object.
It names that object according to the module that calls it, so in our
case the object will be a Foo::Table object.
=head1 Creating a ::Table object
Table objects are responsible for reading, converting, writing, and
deleting data. Since DBD::File provides most of those services, our 'Foo'
subclass only needs to define three methods - fetch_row() to read data,
push_row() to write data, and push_names() to store column names. We will
leave deleting to DBD::File, since deleting a record in the 'Foo' format
is the same process as deleting a record in any other simple file-based
format. Here is the complete object definition:
package Foo::Table;
use base qw(DBD::File::Table);
sub fetch_row {
my($self, $data) = @_;
my $fieldstr = $self->{fh}->getline;
return undef unless $fieldstr;
chomp $fieldstr;
my @fields = split /:/,$fieldstr;
$self->{row} = (@fields ? \@fields : undef);
}
sub push_row {
my($self, $data, $fields) = @_;
my $str = join ':', map { defined $_ ? $_ : '' } @$fields;
$self->{fh}->print( $str."\n");
1;
}
sub push_names {}
1;
The fetch_row() method uses DBD::File's getline() method to physically
read a row of data, then we convert it from native colon-separated format
into a perl arrayref.
The push_row() method converts from a perl arrayref back to colon-separated
format then uses DBD::File's print() method to print it to file.
The push_names method does nothing because it's purpose is to store column
names in a file and in our 'Foo' subclass, we are defining the column names
ourselves, not storing them in a file.
=head1 Trying out our new subclass
Here is a script which should create and query a file in our 'Foo' format.
It assumes you have saved the Foo, Foo::Statement, and Foo::Table classes
shown above into a file called Foo.pm.
#!perl -w
use strict;
use Foo;
my $parser = SQL::Parser->new();
$parser->{RaiseError}=1;
$parser->{PrintError}=0;
for my $sql(split /\n/,
" DROP TABLE IF EXISTS group_id
CREATE TABLE group_id (username CHAR,uid INT, gid INT)
INSERT INTO group_id VALUES('joe',1,1)
INSERT INTO group_id VALUES('sue',2,1)
INSERT INTO group_id VALUES('bob',3,2)
SELECT * FROM group_id "
){
my $stmt = Foo::Statement->new($sql,$parser);
$stmt->execute;
next unless $stmt->command eq 'SELECT';
while (my $row=$stmt->fetch) {
print "@$row\n";
}
}
This is the same script as shown in the section on executing and fetching
in L<SQL::Statement::Structure> except that instead of
SQL::Statement->new(), we are using Foo::Statement->new(). The other
difference is that the execute/fetch example was using in-memory storage
while this script is using file-based storage and the 'Foo' format we
defined. When you run this script, you will be creating a file called
"group_id" and it will contain the specified data in colon-separated
format.
=head1 Developing a new DBD
=head2 Moving from a subclass to a DBD
A DBD based on SQL::Statement uses the same two subclasses that are shown
above. They should be called DBD::Foo::Statement and DBD::Foo::Table, but
would otherwise be identical to the non-DBD subclass illustrated above.
To turn it into a full DBD, you have to subclass DBD::File, DBD::File::dr,
DBD::File::db, and DBD::File::st. In many cases a simple subclass with
few or no methods overridden is sufficient.
Here is a working DBD::Foo:
package DBD::Foo;
use base qw(DBD::File);
package DBD::Foo::dr;
$DBD::Foo::dr::imp_data_size = 0;
use base qw(DBD::File::dr);
package DBD::Foo::db;
$DBD::Foo::db::imp_data_size = 0;
use base qw(DBD::File::db);
package DBD::Foo::st;
$DBD::Foo::st::imp_data_size = 0;
use base qw(DBD::File::st);
package DBD::Foo::Statement;
use base qw(DBD::File::Statement);
sub open_table {
my $self = shift @_;
my $data = shift @_;
$data->{Database}->{f_dir} = './';
my $tbl = $self->SUPER::open_table($data,@_);
$tbl->{col_names} = [qw(username uid gid)];
$tbl->{col_nums} = {username=>0,uid=>1,gid=>2};
return $tbl;
}
package DBD::Foo::Table;
use base qw(DBD::File::Table);
sub fetch_row {
my($self, $data) = @_;
my $fieldstr = $self->{fh}->getline;
return undef unless $fieldstr;
chomp $fieldstr;
my @fields = split /:/,$fieldstr;
$self->{row} = (@fields ? \@fields : undef);
}
sub push_row {
my($self, $data, $fields) = @_;
my $str = join ':', map { defined $_ ? $_ : '' } @$fields;
$self->{fh}->print( $str."\n");
1;
}
sub push_names {}
1;
=head2 A sample script to test our new DBD
Assuming you saved the DBD::Foo shown above as a file called "Foo.pm" in
a directory called "DBD", this script will work, so will most other DBI
methods such as selectall_arrayref, fetchrow_hashref, etc.
#!perl -w
use strict;
use lib qw(/home/jeff/data/module/lib); # or wherever you stored DBD::Foo
use DBI;
my $dbh=DBI->connect('dbi:Foo:');
$dbh->{RaiseError}=1;
$dbh->{PrintError}=0;
for my $sql(split /\n/,
" DROP TABLE IF EXISTS group_id
CREATE TABLE group_id (username CHAR,uid INT, gid INT)
INSERT INTO group_id VALUES('joe',1,1)
INSERT INTO group_id VALUES('sue',2,1)
INSERT INTO group_id VALUES('bob',3,2)
SELECT * FROM group_id "
){
my $stmt = $dbh->prepare($sql);
$stmt->execute;
next unless $stmt->{NUM_OF_FIELDS};
while (my $row=$stmt->fetch) {
print "@$row\n";
}
}
=head1 Expanding the DBD
Now that we have a basic DBD operational, there are several directions for
expansion. In the first place, we might want to override some or all of
DBD::File::Table to provide alternate means of reading, writing, and
deleting from our data source. We might want to override the open_table()
method to provide a different means of identifying column names (e.g.
reading them from the file itself) or to provide other kinds of metadata.
See L<SQL::Eval> for documentation of the API for ::Table objects and see
L<DBD::File> for an example subclass.
We might want to create extensions to the SQL syntax specific to our DBD.
See the section on extending SQL syntax in L<SQL::Statement::Syntax>.
We might want to provide a completely different kind of data source. See
L<DBD::DBM> (whose source code includes documentation on subclassing
SQL::Statement and DBD::File), and other DBD::File subclasses such as
L<DBD::CSV>.
We might also want to provide a completely different storage mechanism,
something not based on files at all. See L<DBD::Amazon> and
L<DBD::AnyData>.
And we will almost certainly want to fine-tune the DBI interface, see
L<DBI::DBD>.
=head1 Getting help with a new DBD
The dbi-devATperl.org mailing list should be your first stop in creating a
new DBD. Tim Bunce, the author of DBI and many DBD authors hang out there.
Tell us what you are planning and we will offer suggestions about similar
modules or other people working on similar issues, or on how to proceed.
=head1 AUTHOR & COPYRIGHT
Copyright (c) 2005, Jeff Zucker <jzuckerATcpan.org>, all rights reserved.
Copyright (c) 2010-2020, Jens Rehsack <rehsackATcpan.org>, all rights reserved.
This document may be freely modified and distributed under the same terms
as Perl itself.
=cut

View File

@@ -0,0 +1,492 @@
package SQL::Statement::Function;
######################################################################
#
# This module is copyright (c), 2009-2020 by Jens Rehsack.
# All rights reserved.
#
# It may be freely distributed under the same terms as Perl itself.
# See below for help and copyright information (search for SYNOPSIS).
#
######################################################################
use strict;
use warnings FATAL => "all";
use vars qw(@ISA $VERSION);
use SQL::Statement::Term ();
@ISA = qw(SQL::Statement::Term);
$VERSION = '1.414';
=pod
=head1 NAME
SQL::Statement::Function - abstract base class for all function executing terms
=head1 SYNOPSIS
# this class does not have a common constructor, because all derived classes
# have their special requirements
=head1 DESCRIPTION
SQL::Statement::Function is an abstract base class providing the interface
for all function executing terms.
=head1 INHERITANCE
SQL::Statement::Function
ISA SQL::Statement::Term
=head1 METHODS
=head2 DESTROY
Destroys the term and undefines the weak reference to the owner as well
as the reference to the parameter list.
=cut
sub DESTROY
{
my $self = $_[0];
undef $self->{PARAMS};
$self->SUPER::DESTROY();
}
package SQL::Statement::Function::UserFunc;
use vars qw(@ISA);
use Carp ();
use Params::Util qw(_INSTANCE);
use SQL::Statement::Functions;
@ISA = qw(SQL::Statement::Function);
=pod
=head1 NAME
SQL::Statement::Function::UserFunc - implements executing a perl subroutine
=head1 SYNOPSIS
# create an user function term with an SQL::Statement object as owner,
# specifying the function name, the subroutine name (full qualified)
# and the parameters to the subroutine
my $term = SQL::Statement::Function::UserFunc->new( $owner, $name, $sub, \@params );
# access the result of that operation
$term->value( $eval );
=head1 DESCRIPTION
SQL::Statement::Function::UserFunc implements a term which returns the result
of the specified subroutine.
=head1 INHERITANCE
SQL::Statement::Function
ISA SQL::Statement::Term
=head1 METHODS
=head2 new
Instantiates a new C<SQL::Statement::Function::UserFunc> instance.
=head2 value
Invokes the given subroutine with the values of the params and return it's
result:
my @params = map { $_->value($eval); } @{ $self->{PARAMS} };
return $subpkg->$subname( $self->{OWNER}, @params );
=cut
sub new
{
my ( $class, $owner, $name, $subnm, $params ) = @_;
my $self = $class->SUPER::new($owner);
my ( $pkg, $sub ) = $subnm =~ m/^(.*::)([^:]+$)/;
if ( !$sub )
{
$sub = $subnm;
$pkg = 'main';
}
$pkg =~ s/::$//g;
$pkg = 'main' unless ($pkg);
$self->{SUB} = $sub;
$self->{PKG} = $pkg;
$self->{NAME} = $name;
$self->{PARAMS} = $params;
unless ( UNIVERSAL::can( $pkg, $sub ) )
{
unless ( 'main' eq $pkg )
{
my $mod = $pkg;
$mod =~ s|::|/|g;
$mod .= '.pm';
eval { require $mod; } unless ( defined( $INC{$mod} ) );
return $owner->do_err($@) if ($@);
}
$pkg->can($sub) or return $owner->do_err( "Can't find subroutine $pkg" . "::$sub" );
}
return $self;
}
sub value($)
{
my $self = $_[0];
my $eval = $_[1];
my $pkg = $self->{PKG};
my $sub = $self->{SUB};
my @params = map { $_->value($eval); } @{ $self->{PARAMS} };
return $pkg->$sub( $self->{OWNER}, @params ); # FIXME is $pkg just a string?
}
package SQL::Statement::Function::NumericEval;
use vars qw(@ISA);
use Params::Util qw(_NUMBER _INSTANCE);
@ISA = qw(SQL::Statement::Function);
=pod
=head1 NAME
SQL::Statement::Function::NumericEval - implements numeric evaluation of a term
=head1 SYNOPSIS
# create an user function term with an SQL::Statement object as owner,
# specifying the expression to evaluate and the parameters to the subroutine
my $term = SQL::Statement::NumericEval->new( $owner, $expr, \@params );
# access the result of that operation
$term->value( $eval );
=head1 DESCRIPTION
SQL::Statement::Function::NumericEval implements the numeric evaluation of a
term. All parameters are expected to be numeric.
=head1 INHERITANCE
SQL::Statement::Function::NumericEval
ISA SQL::Statement::Function
ISA SQL::Statement::Term
=head1 METHODS
=head2 new
Instantiates a new C<SQL::Statement::Function::NumericEval> instance.
Takes I<$owner>, I<$expr> and I<\@params> as arguments (in specified order).
=head2 value
Returns the result of the evaluated expression.
=cut
sub new
{
my ( $class, $owner, $expr, $params ) = @_;
my $self = $class->SUPER::new($owner);
$self->{EXPR} = $expr;
$self->{PARAMS} = $params;
return $self;
}
sub value($)
{
my ( $self, $eval ) = @_;
my @vals =
map { _INSTANCE( $_, 'SQL::Statement::Term' ) ? $_->value($eval) : $_ } @{ $self->{PARAMS} };
foreach my $val (@vals)
{
return $self->{OWNER}->do_err(qq~Bad numeric expression '$val'!~)
unless ( defined( _NUMBER($val) ) );
}
my $expr = $self->{EXPR};
$expr =~ s/\?(\d+)\?/$vals[$1]/g;
$expr =~ s/\s//g;
$expr =~ s/^([\)\(+\-\*\/\%0-9]+)$/$1/; # untaint
return eval $expr;
}
package SQL::Statement::Function::Trim;
use vars qw(@ISA);
BEGIN { @ISA = qw(SQL::Statement::Function); }
=pod
=head1 NAME
SQL::Statement::Function::Trim - implements the built-in trim function support
=head1 SYNOPSIS
# create an trim function term with an SQL::Statement object as owner,
# specifying the spec, char and the parameters to the subroutine
my $term = SQL::Statement::Trim->new( $owner, $spec, $char, \@params );
# access the result of that operation
$term->value( $eval );
=head1 DESCRIPTION
SQL::Statement::Function::Trim implements string trimming.
=head1 INHERITANCE
SQL::Statement::Function::Trim
ISA SQL::Statement::Function
ISA SQL::Statement::Term
=head1 METHODS
=head2 new
Instantiates a new C<SQL::Statement::Function::Trim> instance.
Takes I<$owner>, I<$spec>, I<$char> and I<\@params> as arguments
(in specified order).
Meaning of the parameters:
=over 4
=item I<$spec>
Can be on of 'LEADING', 'TRAILING' 'BOTH'. Trims the leading chars, trailing
chars or at both ends, respectively.
Defaults to 'BOTH'.
=item I<$char>
The character to trim - defaults to C<' '>
=item I<\@params>
Expected to be an array with exact 1 element (more are not evaluated).
=back
=head2 value
Returns the trimmed value of first parameter argument.
=cut
sub new
{
my ( $class, $owner, $spec, $char, $params ) = @_;
$spec ||= 'BOTH';
$char ||= ' ';
my $self = $class->SUPER::new($owner);
$self->{PARAMS} = $params;
$self->{TRIMFN} = sub { my $s = $_[0]; $s =~ s/^$char*//g; return $s; }
if ( $spec =~ m/LEADING/ );
$self->{TRIMFN} = sub { my $s = $_[0]; $s =~ s/$char*$//g; return $s; }
if ( $spec =~ m/TRAILING/ );
$self->{TRIMFN} = sub { my $s = $_[0]; $s =~ s/^$char*//g; $s =~ s/$char*$//g; return $s; }
if ( $spec =~ m/BOTH/ );
return $self;
}
sub value($)
{
my $val = $_[0]->{PARAMS}->[0]->value( $_[1] );
$val = &{ $_[0]->{TRIMFN} }($val);
return $val;
}
package SQL::Statement::Function::SubString;
use vars qw(@ISA);
@ISA = qw(SQL::Statement::Function);
=pod
=head1 NAME
SQL::Statement::Function::SubString - implements the built-in sub-string function support
=head1 SYNOPSIS
# create an substr function term with an SQL::Statement object as owner,
# specifying the start and length of the sub string to extract from the
# first element of \@params
my $term = SQL::Statement::SubString->new( $owner, $start, $length, \@params );
# access the result of that operation
$term->value( $eval );
=head1 DESCRIPTION
SQL::Statement::Function::SubString implements a sub-string extraction term.
=head1 INHERITANCE
SQL::Statement::Function::SubString
ISA SQL::Statement::Function
ISA SQL::Statement::Term
=head1 METHODS
=head2 new
Instantiates a new C<SQL::Statement::Function::SubString> instance.
Takes I<$owner>, I<$start>, I<$length> and I<\@params> as arguments
(in specified order).
Meaning of the parameters:
=over 4
=item I<$start>
Specifies the start position to extract the sub-string. This is expected
to be a L<SQL::Statement::Term> instance. The first character in a string
has the position 1.
=item I<$length>
Specifies the length of the extracted sub-string. This is expected
to be a L<SQL::Statement::Term> instance.
If omitted, everything to the end of the string is returned.
=item I<\@params>
Expected to be an array with exact 1 element (more are not evaluated).
=back
=head2 value
Returns the extracted sub-string value from first parameter argument.
=cut
sub new
{
my ( $class, $owner, $start, $length, $params ) = @_;
my $self = $class->SUPER::new($owner);
$self->{START} = $start;
$self->{LENGTH} = $length;
$self->{PARAMS} = $params;
return $self;
}
sub value($)
{
my $val = $_[0]->{PARAMS}->[0]->value( $_[1] );
my $start = $_[0]->{START}->value( $_[1] ) - 1;
my $length =
defined( $_[0]->{LENGTH} ) ? $_[0]->{LENGTH}->value( $_[1] ) : length($val) - $start;
return substr( $val, $start, $length );
}
package SQL::Statement::Function::StrConcat;
use vars qw(@ISA);
@ISA = qw(SQL::Statement::Function);
=pod
=head1 NAME
SQL::Statement::Function::StrConcat - implements the built-in string concatenation
=head1 SYNOPSIS
# create an substr function term with an SQL::Statement object as owner
# and \@params to concatenate
my $term = SQL::Statement::StrConcat->new( $owner, \@params );
# access the result of that operation
$term->value( $eval );
=head1 DESCRIPTION
SQL::Statement::Function::StrConcat implements a string concatenation term.
=head1 INHERITANCE
SQL::Statement::Function::StrConcat
ISA SQL::Statement::Function
ISA SQL::Statement::Term
=head1 METHODS
=head2 new
Instantiates a new C<SQL::Statement::Function::StrConcat> instance.
=head2 value
Returns the concatenated string composed of the parameter values.
=cut
sub new
{
my ( $class, $owner, $params ) = @_;
my $self = $class->SUPER::new($owner);
$self->{PARAMS} = $params;
return $self;
}
sub value($)
{
my $rc = '';
foreach my $val ( @{ $_[0]->{PARAMS} } )
{
my $catval = $val->value( $_[1] );
$rc .= defined($catval) ? $catval : '';
}
return $rc;
}
=head1 AUTHOR AND COPYRIGHT
Copyright (c) 2009-2020 by Jens Rehsack: rehsackATcpan.org
All rights reserved.
You may distribute this module under the terms of either the GNU
General Public License or the Artistic License, as specified in
the Perl README file.
=cut
1;

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,594 @@
package SQL::Statement::GetInfo;
######################################################################
#
# This module is copyright (c), 2001,2005 by Jeff Zucker.
# This module is copyright (c), 2007-2020 by Jens Rehsack.
# All rights reserved.
#
# It may be freely distributed under the same terms as Perl itself.
# See below for help and copyright information (search for SYNOPSIS).
#
######################################################################
use strict;
use warnings FATAL => "all";
use vars qw($VERSION %info);
$VERSION = '1.414';
use SQL::Statement();
my @Keywords = qw(
INTEGERVAL STRING REALVAL IDENT NULLVAL PARAM OPERATOR IS AND OR ERROR
INSERT UPDATE SELECT DELETE DROP CREATE ALL DISTINCT WHERE ORDER ASC
DESC FROM INTO BY VALUES SET NOT TABLE CHAR VARCHAR REAL INTEGER
PRIMARY KEY BLOB TEXT
);
# FIXME: This should really use the SQL::Dialect keywords, a la:
# return join(',', keys %{ SQL::Dialects::Foobar::get_config_as_hash()->{reserved_words} });
sub sql_keywords
{
return join ',', @Keywords;
}
%info = (
20 => "N" # SQL_ACCESSIBLE_PROCEDURES
,
19 => "Y" # SQL_ACCESSIBLE_TABLES
# 0 => undef # SQL_ACTIVE_CONNECTIONS
# 116 => undef # SQL_ACTIVE_ENVIRONMENTS
# 1 => undef # SQL_ACTIVE_STATEMENTS
,
169 => 0x0000007F # SQL_AGGREGATE_FUNCTIONS
# SQL_AF_AVG + 1
# SQL_AF_COUNT + 2
# SQL_AF_MAX + 4
# SQL_AF_MIN + 8
# SQL_AF_SUM + 10
# SQL_AF_DISTINCT + 20
# SQL_AF_ALL + 40
,
117 => 0 # SQL_ALTER_DOMAIN -
,
86 => 0 # SQL_ALTER_TABLE -
# 10021 => undef # SQL_ASYNC_MODE
# 120 => undef # SQL_BATCH_ROW_COUNT
# 121 => undef # SQL_BATCH_SUPPORT
# 82 => undef # SQL_BOOKMARK_PERSISTENCE
,
114 => 1 # SQL_CATALOG_LOCATION
,
10003 => "N" # SQL_CATALOG_NAME
,
41 => '.' # SQL_CATALOG_NAME_SEPARATOR
,
42 => "" # SQL_CATALOG_TERM
,
92 => 0 # SQL_CATALOG_USAGE
#
# 10004 => undef # SQL_COLLATING_SEQUENCE
,
10004 => "ISO-8859-1" # SQL_COLLATION_SEQ
,
87 => "Y" # SQL_COLUMN_ALIAS
,
22 => 0 # SQL_CONCAT_NULL_BEHAVIOR
#
# CONVERT FUNCTION NOT CURRENTLY SUPPORTED
#
,
53 => 0 # SQL_CONVERT_BIGINT
,
54 => 0 # SQL_CONVERT_BINARY
,
55 => 0 # SQL_CONVERT_BIT
,
56 => 0 # SQL_CONVERT_CHAR
,
57 => 0 # SQL_CONVERT_DATE
,
58 => 0 # SQL_CONVERT_DECIMAL
,
59 => 0 # SQL_CONVERT_DOUBLE
,
60 => 0 # SQL_CONVERT_FLOAT
,
48 => 0 # SQL_CONVERT_FUNCTIONS
,
173 => 0 # SQL_CONVERT_GUID
,
61 => 0 # SQL_CONVERT_INTEGER
,
123 => 0 # SQL_CONVERT_INTERVAL_DAY_TIME
,
124 => 0 # SQL_CONVERT_INTERVAL_YEAR_MONTH
,
71 => 0 # SQL_CONVERT_LONGVARBINARY
,
62 => 0 # SQL_CONVERT_LONGVARCHAR
,
63 => 0 # SQL_CONVERT_NUMERIC
,
64 => 0 # SQL_CONVERT_REAL
,
65 => 0 # SQL_CONVERT_SMALLINT
,
66 => 0 # SQL_CONVERT_TIME
,
67 => 0 # SQL_CONVERT_TIMESTAMP
,
68 => 0 # SQL_CONVERT_TINYINT
,
69 => 0 # SQL_CONVERT_VARBINARY
,
70 => 0 # SQL_CONVERT_VARCHAR
,
122 => 0 # SQL_CONVERT_WCHAR
,
125 => 0 # SQL_CONVERT_WLONGVARCHAR
,
126 => 0 # SQL_CONVERT_WVARCHAR
,
74 => 2 # SQL_CORRELATION_NAME
,
127 => 0 # SQL_CREATE_ASSERTION
,
128 => 0 # SQL_CREATE_CHARACTER_SET
,
129 => 0 # SQL_CREATE_COLLATION
,
130 => 0 # SQL_CREATE_DOMAIN
,
131 => 0 # SQL_CREATE_SCHEMA
,
132 => 0x00000015 # SQL_CREATE_TABLE
# SQL_CT_CREATE_TABLE => 0x00000001 +
# SQL_CT_COMMIT_PRESERVE => 0x00000002
# SQL_CT_COMMIT_DELETE => 0x00000004 +
# SQL_CT_GLOBAL_TEMPORARY => 0x00000008
# SQL_CT_LOCAL_TEMPORARY => 0x00000010 +
# SQL_CT_CONSTRAINT_INITIALLY_DEFERRED => 0x00000020
# SQL_CT_CONSTRAINT_INITIALLY_IMMEDIATE => 0x00000040
# SQL_CT_CONSTRAINT_DEFERRABLE => 0x00000080
# SQL_CT_CONSTRAINT_NON_DEFERRABLE => 0x00000100
# SQL_CT_COLUMN_CONSTRAINT => 0x00000200
# SQL_CT_COLUMN_DEFAULT => 0x00000400
# SQL_CT_COLUMN_COLLATION => 0x00000800
# SQL_CT_TABLE_CONSTRAINT => 0x00001000
# SQL_CT_CONSTRAINT_NAME_DEFINITION => 0x00002000
,
133 => 0 # SQL_CREATE_TRANSLATION
,
134 => 0 # SQL_CREATE_VIEW
#
# CURSORS NOT CURRENTLY SUPPORTED
#
# 23 => undef, # SQL_CURSOR_COMMIT_BEHAVIOR
# 24 => undef, # SQL_CURSOR_ROLLBACK_BEHAVIOR
# 10001 => undef, # SQL_CURSOR_SENSITIVITY
#
#, 2 => \&sql_data_source_name # SQL_DATA_SOURCE_NAME
,
25 => "N" # SQL_DATA_SOURCE_READ_ONLY
,
119 => 0 # SQL_DATETIME_LITERALS
#, 17 => \&sql_driver_name # SQL_DBMS_NAME
#, 18 => \&sql_driver_ver # SQL_DBMS_VER
# 18 => undef # SQL_DBMS_VERSION
# 170 => undef, # SQL_DDL_INDEX
# 26 => undef, # SQL_DEFAULT_TRANSACTION_ISOLATION
# 26 => undef # SQL_DEFAULT_TXN_ISOLATION
,
10002 => "N" # SQL_DESCRIBE_PARAMETER
# 171 => undef # SQL_DM_VER
# 3 => undef # SQL_DRIVER_HDBC
# 135 => undef # SQL_DRIVER_HDESC
# 4 => undef # SQL_DRIVER_HENV
# 76 => undef # SQL_DRIVER_HLIB
# 5 => undef # SQL_DRIVER_HSTMT
#, 6 => \&sql_driver_name # SQL_DRIVER_NAME
# 77 => undef # SQL_DRIVER_ODBC_VER
#, 7 => \&sql_driver_ver # SQL_DRIVER_VER
,
136 => 0 # SQL_DROP_ASSERTION
,
137 => 0 # SQL_DROP_CHARACTER_SET
,
138 => 0 # SQL_DROP_COLLATION
,
139 => 0 # SQL_DROP_DOMAIN
,
140 => 0 # SQL_DROP_SCHEMA
,
141 => 1 # SQL_DROP_TABLE
,
142 => 0 # SQL_DROP_TRANSLATION
,
143 => 0 # SQL_DROP_VIEW
# 144 => undef # SQL_DYNAMIC_CURSOR_ATTRIBUTES1
# 145 => undef # SQL_DYNAMIC_CURSOR_ATTRIBUTES2
# 27 => undef # SQL_EXPRESSIONS_IN_ORDERBY
# 8 => undef # SQL_FETCH_DIRECTION
,
84 => 1 # SQL_FILE_USAGE
# 146 => undef # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES1
# 147 => undef # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES2
# 81 => undef # SQL_GETDATA_EXTENSIONS
# 88 => undef # SQL_GROUP_BY
,
28 => 4 # SQL_IDENTIFIER_CASE
,
29 => q(") # SQL_IDENTIFIER_QUOTE_CHAR
# 148 => undef # SQL_INDEX_KEYWORDS
# 149 => undef # SQL_INFO_SCHEMA_VIEWS
,
172 => 1 # SQL_INSERT_STATEMENT
# 73 => undef # SQL_INTEGRITY
# 150 => undef # SQL_KEYSET_CURSOR_ATTRIBUTES1
# 151 => undef # SQL_KEYSET_CURSOR_ATTRIBUTES2
,
89 => \&sql_keywords # SQL_KEYWORDS
,
113 => "N" # SQL_LIKE_ESCAPE_CLAUSE
# 78 => undef # SQL_LOCK_TYPES
# 34 => undef # SQL_MAXIMUM_CATALOG_NAME_LENGTH
# 97 => undef # SQL_MAXIMUM_COLUMNS_IN_GROUP_BY
# 98 => undef # SQL_MAXIMUM_COLUMNS_IN_INDEX
# 99 => undef # SQL_MAXIMUM_COLUMNS_IN_ORDER_BY
# 100 => undef # SQL_MAXIMUM_COLUMNS_IN_SELECT
# 101 => undef # SQL_MAXIMUM_COLUMNS_IN_TABLE
# 30 => undef # SQL_MAXIMUM_COLUMN_NAME_LENGTH
# 1 => undef # SQL_MAXIMUM_CONCURRENT_ACTIVITIES
# 31 => undef # SQL_MAXIMUM_CURSOR_NAME_LENGTH
# 0 => undef # SQL_MAXIMUM_DRIVER_CONNECTIONS
# 10005 => undef # SQL_MAXIMUM_IDENTIFIER_LENGTH
# 102 => undef # SQL_MAXIMUM_INDEX_SIZE
# 104 => undef # SQL_MAXIMUM_ROW_SIZE
# 32 => undef # SQL_MAXIMUM_SCHEMA_NAME_LENGTH
# 105 => undef # SQL_MAXIMUM_STATEMENT_LENGTH
# 20000 => undef # SQL_MAXIMUM_STMT_OCTETS
# 20001 => undef # SQL_MAXIMUM_STMT_OCTETS_DATA
# 20002 => undef # SQL_MAXIMUM_STMT_OCTETS_SCHEMA
# 106 => undef # SQL_MAXIMUM_TABLES_IN_SELECT
# 35 => undef # SQL_MAXIMUM_TABLE_NAME_LENGTH
# 107 => undef # SQL_MAXIMUM_USER_NAME_LENGTH
# 10022 => undef # SQL_MAX_ASYNC_CONCURRENT_STATEMENTS
# 112 => undef # SQL_MAX_BINARY_LITERAL_LEN
# 34 => undef # SQL_MAX_CATALOG_NAME_LEN
# 108 => undef # SQL_MAX_CHAR_LITERAL_LEN
# 97 => undef # SQL_MAX_COLUMNS_IN_GROUP_BY
# 98 => undef # SQL_MAX_COLUMNS_IN_INDEX
# 99 => undef # SQL_MAX_COLUMNS_IN_ORDER_BY
# 100 => undef # SQL_MAX_COLUMNS_IN_SELECT
# 101 => undef # SQL_MAX_COLUMNS_IN_TABLE
# 30 => undef # SQL_MAX_COLUMN_NAME_LEN
# 1 => undef # SQL_MAX_CONCURRENT_ACTIVITIES
# 31 => undef # SQL_MAX_CURSOR_NAME_LEN
# 0 => undef # SQL_MAX_DRIVER_CONNECTIONS
# 10005 => undef # SQL_MAX_IDENTIFIER_LEN
# 102 => undef # SQL_MAX_INDEX_SIZE
# 32 => undef # SQL_MAX_OWNER_NAME_LEN
# 33 => undef # SQL_MAX_PROCEDURE_NAME_LEN
# 34 => undef # SQL_MAX_QUALIFIER_NAME_LEN
# 104 => undef # SQL_MAX_ROW_SIZE
# 103 => undef # SQL_MAX_ROW_SIZE_INCLUDES_LONG
# 32 => undef # SQL_MAX_SCHEMA_NAME_LEN
# 105 => undef # SQL_MAX_STATEMENT_LEN
# 106 => undef # SQL_MAX_TABLES_IN_SELECT
# 35 => undef # SQL_MAX_TABLE_NAME_LEN
# 107 => undef # SQL_MAX_USER_NAME_LEN
# 37 => undef # SQL_MULTIPLE_ACTIVE_TXN
# 36 => undef # SQL_MULT_RESULT_SETS
,
111 => "N" # SQL_NEED_LONG_DATA_LEN
,
75 => 1 # SQL_NON_NULLABLE_COLUMNS
,
85 => 1 # SQL_NULL_COLLATION
,
49 => 0 # SQL_NUMERIC_FUNCTIONS
# 9 => undef # SQL_ODBC_API_CONFORMANCE
# 152 => undef # SQL_ODBC_INTERFACE_CONFORMANCE
# 12 => undef # SQL_ODBC_SAG_CLI_CONFORMANCE
# 15 => undef # SQL_ODBC_SQL_CONFORMANCE
# 73 => undef # SQL_ODBC_SQL_OPT_IEF
# 10 => undef # SQL_ODBC_VER
,
115 => 0x00000037 # SQL_OJ_CAPABILITIES
# 1 SQL_OJ_LEFT + left joins SUPPORTED
# 2 SQL_OJ_RIGHT + right joins SUPPORTED
# 4 SQL_OJ_FULL + full joins SUPPORTED
# SQL_OJ_NESTED - nested joins not supported
# 10 SQL_OJ_NOT_ORDERED + on clause col order not required
# 20 SQL_OJ_INNER + inner joins SUPPORTED
# SQL_OJ_ALL_COMPARISON_OPS - on clause comp op must be =
,
90 => "N" # SQL_ORDER_BY_COLUMNS_IN_SELECT
# 38 => undef # SQL_OUTER_JOINS
# 115 => undef # SQL_OUTER_JOIN_CAPABILITIES
# 39 => undef # SQL_OWNER_TERM
# 91 => undef # SQL_OWNER_USAGE
# 153 => undef # SQL_PARAM_ARRAY_ROW_COUNTS
# 154 => undef # SQL_PARAM_ARRAY_SELECTS
# 80 => undef # SQL_POSITIONED_STATEMENTS
# 79 => undef # SQL_POS_OPERATIONS
,
21 => "N" # SQL_PROCEDURES
# 40 => undef # SQL_PROCEDURE_TERM
# 114 => undef # SQL_QUALIFIER_LOCATION
# 41 => undef # SQL_QUALIFIER_NAME_SEPARATOR
# 42 => undef # SQL_QUALIFIER_TERM
# 92 => undef # SQL_QUALIFIER_USAGE
,
93 => 3 # SQL_QUOTED_IDENTIFIER_CASE
,
11 => "N" # SQL_ROW_UPDATES
,
39 => "schema" # SQL_SCHEMA_TERM
# 91 => undef # SQL_SCHEMA_USAGE
# 43 => undef # SQL_SCROLL_CONCURRENCY
# 44 => undef # SQL_SCROLL_OPTIONS
# 14 => undef # SQL_SEARCH_PATTERN_ESCAPE
# 13 => undef # SQL_SERVER_NAME
# 94 => undef # SQL_SPECIAL_CHARACTERS
,
155 => 8 # SQL_SQL92_DATETIME_FUNCTIONS
# SQL_SDF_CURRENT_DATE => 0x00000001 +
# SQL_SDF_CURRENT_TIME => 0x00000002 +
# SQL_SDF_CURRENT_TIMESTAMP => 0x00000004 +
# 156 => undef # SQL_SQL92_FOREIGN_KEY_DELETE_RULE
# 157 => undef # SQL_SQL92_FOREIGN_KEY_UPDATE_RULE
# 158 => undef # SQL_SQL92_GRANT
,
159 => 0x00FFFFFF # SQL_SQL92_NUMERIC_VALUE_FUNCTIONS
# All of them!
# SQL_FN_NUM_ABS => 0x00000001 +
# SQL_FN_NUM_ACOS => 0x00000002 +
# SQL_FN_NUM_ASIN => 0x00000004 +
# SQL_FN_NUM_ATAN => 0x00000008 +
# SQL_FN_NUM_ATAN2 => 0x00000010 +
# SQL_FN_NUM_CEILING => 0x00000020 +
# SQL_FN_NUM_COS => 0x00000040 +
# SQL_FN_NUM_COT => 0x00000080 +
# SQL_FN_NUM_EXP => 0x00000100 +
# SQL_FN_NUM_FLOOR => 0x00000200 +
# SQL_FN_NUM_LOG => 0x00000400 +
# SQL_FN_NUM_MOD => 0x00000800 +
# SQL_FN_NUM_SIGN => 0x00001000 +
# SQL_FN_NUM_SIN => 0x00002000 +
# SQL_FN_NUM_SQRT => 0x00004000 +
# SQL_FN_NUM_TAN => 0x00008000 +
# SQL_FN_NUM_PI => 0x00010000 +
# SQL_FN_NUM_RAND => 0x00020000 +
# SQL_FN_NUM_DEGREES => 0x00040000 +
# SQL_FN_NUM_LOG10 => 0x00080000 +
# SQL_FN_NUM_POWER => 0x00100000 +
# SQL_FN_NUM_RADIANS => 0x00200000 +
# SQL_FN_NUM_ROUND => 0x00400000 +
# SQL_FN_NUM_TRUNCATE => 0x00800000 +
,
160 => 0x00003E06 # SQL_SQL92_PREDICATES
# SQL_SP_EXISTS - -
# SQL_SP_ISNOTNULL + + 2
# SQL_SP_ISNULL + + 4
# SQL_SP_MATCH_FULL - -
# SQL_SP_MATCH_PARTIAL - -
# SQL_SP_MATCH_UNIQUE_FULL - -
# SQL_SP_MATCH_UNIQUE_PARTIAL - -
# SQL_SP_OVERLAPS - -
# SQL_SP_UNIQUE - -
# SQL_SP_LIKE + + 200
# SQL_SP_IN - + 400
# SQL_SP_BETWEEN - + 800
# SQL_SP_COMPARISON + + 1000
# SQL_SP_QUANTIFIED_COMPARISON + + 2000
,
161 => 0x000001D8 # SQL_SQL92_RELATIONAL_JOIN_OPERATORS
# SQL_SRJO_CORRESPONDING_CLAUSE - corresponding clause not supported
# SQL_SRJO_CROSS_JOIN - cross join not supported
# SQL_SRJO_EXCEPT_JOIN - except join not supported
# 8 SQL_SRJO_FULL_OUTER_JOIN + full join SUPPORTED
# 10 SQL_SRJO_INNER_JOIN + inner join SUPPORTED
# SQL_SRJO_INTERSECT_JOIN - intersect join not supported
# 40 SQL_SRJO_LEFT_OUTER_JOIN + left join SUPPORTED
# 80 SQL_SRJO_NATURAL_JOIN + natural join SUPPORTED
# 100 SQL_SRJO_RIGHT_OUTER_JOIN + right join SUPPORTED
# SQL_SRJO_UNION_JOIN - union join not supported
# 162 => undef # SQL_SQL92_REVOKE
,
163 => 3 # SQL_SQL92_ROW_VALUE_CONSTRUCTOR
# SQL_SRVC_VALUE_EXPRESSION
# SQL_SRVC_NULL
# SQL_SRVC_DEFAULT
# SQL_SRVC_ROW_SUBQUERY
,
164 => 0x000000FE # SQL_SQL92_STRING_FUNCTIONS
# SQL_SSF_CONVERT => 0x00000001
# SQL_SSF_LOWER => 0x00000002 +
# SQL_SSF_UPPER => 0x00000004 +
# SQL_SSF_SUBSTRING => 0x00000008 +
# SQL_SSF_TRANSLATE => 0x00000010 +
# SQL_SSF_TRIM_BOTH => 0x00000020 +
# SQL_SSF_TRIM_LEADING => 0x00000040 +
# SQL_SSF_TRIM_TRAILING => 0x00000080 +
# 165 => undef # SQL_SQL92_VALUE_EXPRESSIONS
# 118 => undef # SQL_SQL_CONFORMANCE
# 166 => undef # SQL_STANDARD_CLI_CONFORMANCE
# 167 => undef # SQL_STATIC_CURSOR_ATTRIBUTES1
# 168 => undef # SQL_STATIC_CURSOR_ATTRIBUTES2
# 83 => undef # SQL_STATIC_SENSITIVITY
,
50 => 0x00FF7FFF # SQL_STRING_FUNCTIONS
# SQL_FN_STR_CONCAT => 0x00000001 +
# SQL_FN_STR_INSERT => 0x00000002 +
# SQL_FN_STR_LEFT => 0x00000004 +
# SQL_FN_STR_LTRIM => 0x00000008 +
# SQL_FN_STR_LENGTH => 0x00000010 +
# SQL_FN_STR_LOCATE => 0x00000020 +
# SQL_FN_STR_LCASE => 0x00000040 +
# SQL_FN_STR_REPEAT => 0x00000080 +
# SQL_FN_STR_REPLACE => 0x00000100 +
# SQL_FN_STR_RIGHT => 0x00000200 +
# SQL_FN_STR_RTRIM => 0x00000400 +
# SQL_FN_STR_SUBSTRING => 0x00000800 +
# SQL_FN_STR_UCASE => 0x00001000 +
# SQL_FN_STR_ASCII => 0x00002000 +
# SQL_FN_STR_CHAR => 0x00004000 +
# SQL_FN_STR_DIFFERENCE => 0x00008000
# SQL_FN_STR_LOCATE_2 => 0x00010000 +
# SQL_FN_STR_SOUNDEX => 0x00020000 +
# SQL_FN_STR_SPACE => 0x00040000 +
# SQL_FN_STR_BIT_LENGTH => 0x00080000 +
# SQL_FN_STR_CHAR_LENGTH => 0x00100000 +
# SQL_FN_STR_CHARACTER_LENGTH => 0x00200000 +
# SQL_FN_STR_OCTET_LENGTH => 0x00400000 +
# SQL_FN_STR_POSITION => 0x00800000 +
# 95 => undef # SQL_SUBQUERIES
,
51 => 8 # SQL_SYSTEM_FUNCTIONS
# SQL_FN_SYS_USERNAME => 0x00000001 +
# SQL_FN_SYS_DBNAME => 0x00000002 +
# SQL_FN_SYS_IFNULL => 0x00000004 +
,
45 => "table" # SQL_TABLE_TERM
# 109 => undef # SQL_TIMEDATE_ADD_INTERVALS
# 110 => undef # SQL_TIMEDATE_DIFF_INTERVALS
,
52 => 0x000E0203 # SQL_TIMEDATE_FUNCTIONS
# SQL_FN_TD_NOW => 0x00000001 +
# SQL_FN_TD_CURDATE => 0x00000002 +
# SQL_FN_TD_DAYOFMONTH => 0x00000004
# SQL_FN_TD_DAYOFWEEK => 0x00000008
# SQL_FN_TD_DAYOFYEAR => 0x00000010
# SQL_FN_TD_MONTH => 0x00000020
# SQL_FN_TD_QUARTER => 0x00000040
# SQL_FN_TD_WEEK => 0x00000080
# SQL_FN_TD_YEAR => 0x00000100
# SQL_FN_TD_CURTIME => 0x00000200 +
# SQL_FN_TD_HOUR => 0x00000400
# SQL_FN_TD_MINUTE => 0x00000800
# SQL_FN_TD_SECOND => 0x00001000
# SQL_FN_TD_TIMESTAMPADD => 0x00002000
# SQL_FN_TD_TIMESTAMPDIFF => 0x00004000
# SQL_FN_TD_DAYNAME => 0x00008000
# SQL_FN_TD_MONTHNAME => 0x00010000
# SQL_FN_TD_CURRENT_DATE => 0x00020000 +
# SQL_FN_TD_CURRENT_TIME => 0x00040000 +
# SQL_FN_TD_CURRENT_TIMESTAMP => 0x00080000 +
# SQL_FN_TD_EXTRACT => 0x00100000
# 46 => undef # SQL_TRANSACTION_CAPABLE
# 72 => undef # SQL_TRANSACTION_ISOLATION_OPTION
# 46 => undef # SQL_TXN_CAPABLE
# 72 => undef # SQL_TXN_ISOLATION_OPTION
# 96 => undef # SQL_UNION
# 96 => undef # SQL_UNION_STATEMENT
# 47 => \&sql_user_name # SQL_USER_NAME
# 10000 => undef # SQL_XOPEN_CLI_YEAR
);
1;
__END__
NO LONGER NEEDED
sub sql_driver_name {
shift->{"Driver"}->{"Name"};
}
sub sql_driver_ver {
my $dbh = shift;
my $ver = shift;
my $drv = 'DBD::'.$dbh->{"Driver"}->{"Name"};
# $ver = "$drv"."::VERSION";
# $ver = ${$ver};
my $fmt = '%02d.%02d.%1d%1d%1d%1d'; # ODBC version string: ##.##.#####
$ver = sprintf $fmt, split (/\./, $ver);
return $ver . '; ss-'. $SQL::Statement::VERSION;
}
sub sql_data_source_name {
my $dbh = shift;
return 'dbi:'.$dbh->{"Driver"}->{"Name"}.':'.$dbh->{"Name"};
}
sub sql_user_name {
my $dbh = shift;
return $dbh->{"CURRENT_USER"};
}
=pod
=head1 NAME
SQL::Statement::GetInfo
=head1 SYNOPSIS
# see L<DBI>
=head1 DESCRIPTION
This package contains support for C<$dbh->get_info()>.
=head1 INHERITANCE
SQL::Statement::GetInfo
=begin undocumented
=head1 METHODS
=head2 sql_keywords
Returns the list of keywords
=end undocumented
=head1 AUTHOR & COPYRIGHT
This module is
copyright (c) 2001,2005 by Jeff Zucker and
copyright (c) 2007-2020 by Jens Rehsack.
All rights reserved.
The module may be freely distributed under the same terms as
Perl itself using either the "GPL License" or the "Artistic
License" as specified in the Perl README file.
Jeff can be reached at: jzuckerATcpan.org
Jens can be reached at: rehsackATcpan.org or via dbi-devATperl.org
=cut

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,98 @@
package SQL::Statement::Placeholder;
######################################################################
#
# This module is copyright (c), 2009-2020 by Jens Rehsack.
# All rights reserved.
#
# It may be freely distributed under the same terms as Perl itself.
# See below for help and copyright information (search for SYNOPSIS).
#
######################################################################
use strict;
use warnings FATAL => "all";
use vars qw(@ISA);
use Carp ();
use SQL::Statement::Term ();
our $VERSION = '1.414';
@ISA = qw(SQL::Statement::Term);
=pod
=head1 NAME
SQL::Statement::Placeholder - implements getting the next placeholder value
=head1 SYNOPSIS
# create an placeholder term with an SQL::Statement object as owner
# and the $argnum of the placeholder.
my $term = SQL::Statement::Placeholder->new( $owner, $argnum );
# access the result of that operation
$term->value( $eval );
=head1 DESCRIPTION
SQL::Statement::Placeholder implements getting the next placeholder value.
Accessing a specific placeholder is currently unimplemented and not tested.
=head1 INHERITANCE
SQL::Statement::Placeholder
ISA SQL::Statement::Term
=head1 METHODS
=head2 new
Instantiates a new C<SQL::Statement::Placeholder> instance.
=head2 value
Returns the value of the next placeholder.
=cut
sub new
{
my ( $class, $owner, $argnum ) = @_;
my $self = $class->SUPER::new($owner);
$self->{ARGNUM} = $argnum;
return $self;
}
sub value($)
{
# from S::S->get_row_value():
# my $val = (
# $self->{join}
# or !$eval
# or ref($eval) =~ /Statement$/
# ) ? $self->params($arg_num) : $eval->param($arg_num);
# let's see where us will lead taking from params every time
# XXX later: return $_[0]->{OWNER}->{params}->[$_[0]->{ARGNUM}];
return $_[0]->{OWNER}->{params}->[ $_[0]->{OWNER}->{argnum}++ ];
}
=head1 AUTHOR AND COPYRIGHT
Copyright (c) 2009-2020 by Jens Rehsack: rehsackATcpan.org
All rights reserved.
You may distribute this module under the terms of either the GNU
General Public License or the Artistic License, as specified in
the Perl README file.
=cut
1;

View File

@@ -0,0 +1,303 @@
############################
package SQL::Statement::RAM;
############################
######################################################################
#
# This module is copyright (c), 2001,2005 by Jeff Zucker.
# This module is copyright (c), 2007-2020 by Jens Rehsack.
# All rights reserved.
#
# It may be freely distributed under the same terms as Perl itself.
# See below for help and copyright information (search for SYNOPSIS).
#
######################################################################
use strict;
use warnings FATAL => "all";
use vars qw($VERSION);
$VERSION = '1.414';
####################################
package SQL::Statement::RAM::Table;
####################################
use strict;
use warnings FATAL => "all";
use SQL::Eval ();
use vars qw(@ISA);
@ISA = qw(SQL::Eval::Table);
use Carp qw(croak);
sub new
{
my ( $class, $tname, $col_names, $data_tbl ) = @_;
my %table = (
NAME => $tname,
index => 0,
records => $data_tbl,
col_names => $col_names,
capabilities => {
inplace_update => 1,
inplace_delete => 1,
},
);
my $self = $class->SUPER::new( \%table );
}
##################################
# fetch_row()
##################################
sub fetch_row
{
my ( $self, $data ) = @_;
return $self->{row} =
( $self->{records} and ( $self->{index} < scalar( @{ $self->{records} } ) ) )
? [ @{ $self->{records}->[ $self->{index}++ ] } ]
: undef;
}
####################################
# insert_new_row()
####################################
sub insert_new_row
{
my ( $self, $data, $fields ) = @_;
push @{ $self->{records} }, [ @{$fields} ];
return 1;
}
##################################
# delete_current_row()
##################################
sub delete_current_row
{
my ( $self, $data, $fields ) = @_;
my $currentRow = $self->{index} - 1;
croak "No current row" unless ( $currentRow >= 0 );
splice @{ $self->{records} }, $currentRow, 1;
--$self->{index};
return 1;
}
##################################
# update_current_row()
##################################
sub update_current_row
{
my ( $self, $data, $fields ) = @_;
my $currentRow = $self->{index} - 1;
croak "No current row" unless ( $currentRow >= 0 );
$self->{records}->[$currentRow] = [ @{$fields} ];
return 1;
}
##################################
# truncate()
##################################
sub truncate
{
return splice @{ $_[0]->{records} }, $_[0]->{index};
}
#####################################
# push_names()
#####################################
sub push_names
{
my ( $self, $data, $names ) = @_;
$self->{col_names} = $names;
$self->{org_col_names} = [ @{$names} ];
$self->{col_nums} = SQL::Eval::Table::_map_colnums($names);
}
#####################################
# drop()
#####################################
sub drop
{
my ( $self, $data ) = @_;
my $tname = $self->{NAME};
delete $data->{Database}->{sql_ram_tables}->{$tname};
return 1;
}
#####################################
# seek()
#####################################
sub seek
{
my ( $self, $data, $pos, $whence ) = @_;
return unless defined $self->{records};
my ($currentRow) = $self->{index};
if ( $whence == 0 )
{
$currentRow = $pos;
}
elsif ( $whence == 1 )
{
$currentRow += $pos;
}
elsif ( $whence == 2 )
{
$currentRow = @{ $self->{records} } + $pos;
}
else
{
croak $self . "->seek: Illegal whence argument ($whence)";
}
if ( $currentRow < 0 )
{
croak "Illegal row number: $currentRow";
}
$self->{index} = $currentRow;
}
1;
=pod
=head1 NAME
SQL::Statement::RAM
=head1 SYNOPSIS
SQL::Statement::RAM
=head1 DESCRIPTION
This package contains support for the internally used
SQL::Statement::RAM::Table.
=head1 INHERITANCE
SQL::Statement::RAM
SQL::Statement::RAM::Table
ISA SQL::Eval::Table
=head1 SQL::Statement::RAM::Table
=head2 METHODS
=over 8
=item new
Instantiates a new C<SQL::Statement::RAM::Table> object, used for temporary
tables.
CREATE TEMP TABLE foo ....
=item fetch_row
Fetches the next row
=item push_row
As fetch_row except for writing
=item delete_current_row
Deletes the last fetched/pushed row
=item update_current_row
Updates the last fetched/pushed row
=item truncate
Truncates the table at the current position
=item push_names
Set the column names of the table
=item drop
Discards the table
=item seek
Seek the row pointer
=back
=head2 CAPABILITIES
This table has following capabilities:
=over 8
=item update_current_row
Using provided method C<update_current_row> and capability C<inplace_update>.
=item rowwise_update
By providing capability C<update_current_row>.
=item inplace_update
By definition (appropriate flag set in constructor).
=item delete_current_row
Using provided method C<delete_current_row> and capability C<inplace_delete>.
=item rowwise_delete
By providing capability C<delete_current_row>.
=item inplace_delete
By definition (appropriate flag set in constructor).
=back
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc SQL::Statement
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=SQL-Statement>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/SQL-Statement>
=item * CPAN Ratings
L<http://cpanratings.perl.org/s/SQL-Statement>
=item * Search CPAN
L<http://search.cpan.org/dist/SQL-Statement/>
=back
=head1 AUTHOR AND COPYRIGHT
Copyright (c) 2001,2005 by Jeff Zucker: jzuckerATcpan.org
Copyright (c) 2007-2020 by Jens Rehsack: rehsackATcpan.org
All rights reserved.
You may distribute this module under the terms of either the GNU
General Public License or the Artistic License, as specified in
the Perl README file.
=cut

View File

@@ -0,0 +1,249 @@
=head1 NAME
SQL::Statement::Roadmap - Planned Enhancements for SQL::Statement and SQL::Parser
Jens Rehsack - June 2010
=head1 SYNOPSIS
This document gives a high level overview of the future of SQL::Statement,
SQL::Parser and its impact.
The planned enhancements cover testing, performance, reliability,
extensibility and more.
=head1 CHANGES AND ENHANCEMENTS
=head2 Enhancements in SQL::Statement 1.xx
SQL::Statement 1.xx will not receive big changes, but a few enhancements
may help us to design SQL::Statement 2.xx much better.
=head3 CREATE and DROP of FUNCTION, KEYWORD, OPERATOR, TYPE
SQL::Statement is missing some functions, types, operators etc. It's
supported to add missing functionality - but the implementation was not
picked up during the modernizing of column evaluation. See RT#52397
for some more information.
This should be done before SQL::Statement 1.xx reaches the end of its
road.
=head3 Parser improvements
The SQL::Parser is implemented based on a lot of regular expressions
and some manually developed logic. This creates some issues like
RT#53416 or RT#55190. Further, trailing C<;> causes SQL::Parser to
croak. We need to decide what can be fixed without internal design
changes and what has to wait.
=head3 Performance
There is no intention to work on performance improvements in
SQL::Statement 1.xx. The performance is good as it is and improvement
requires design changes.
=head3 Reliability
Bugs will be fixed - where possible. SQL::Statement 1.28 is much more
reliable than SQL::Statement 1.15. Even if a bug cannot be fixed all
issues are gratefully received as they will be considered in the
design process for SQL::Statement 2.xx better.
=head3 Extensibility
SQL::Statement 1.xx is highly extensible, even if a more object oriented
design would improve that. The 1.xx branch will not be redesigned for
greater extensibility on a coding level.
=head2 Enhancements in SQL::Statement 2.xx
Concerning the procedural design of SQL::Statement 1.xx a rewrite of the
basic components is required.
=head3 SQL::Parser rewrite
The SQL::Parser needs to be modified to be able to use a
L<Backus Naur Form|http://en.wikipedia.org/wiki/Backus_Naur_Form>.
This would allow users and developers to rely on many different
SQL dialects. This will allow better extensibility from a feature
point of view without losing ANSI SQL compatibility.
=head3 SQL::Statement rewrite
SQL::Statement should be reduced to a simple coordinating engine. The
executing tasks should be organized into separated commands. This will
reduce side effects and will open the door for higher level optimizations,
reliability improvements or sub-selects (or other calculated tables).
=head3 Features
There is a large list of missing features but not all table backends
will be able to support each new feature. The most popular requested
features need additional discussion and everyone is welcome to do it
on the L<mailto:dbi-dev@perl.org|DBI Development Mailing List>.
=head4 LOCK TABLE
Locking table within SQL scripts to manually control table consistence over
several operations. The current locking support is restricted to one
statement.
=head4 Transaction support
Executing statements on a temporary copy of the table data.
The easiest way to implement this would be to create a
L<SQL::Statement::RAM|SQL::Statement::RAM::Table> on C<BEGIN TRANSACTION>
and write the entire table back on C<COMMIT> or discard on C<ROLLBACK>.
Better performance could be achieved in cases where the implementation is
enabled to memorize pending modifications and apply them at C<COMMIT>.
On the other hand there are already
L<capabilities|SQL::Eval/"Method interface of SQL::Eval::Table"> to
improve some operations, which might create confusion in case of
transactions.
This needs more discussion.
=head4 ALTER TABLE
Adding, removing or modifying columns is not supported for created
tables. A generic C<ALTER TABLE> seems to rely on the implementation
of the transaction support - until better ideas are provided.
=head4 Indices
Currently some table backends have implicit support to access
specified rows quicker than fetching each row and evaluating the where
clause against the row data.
An interface would be required to configure fetching to return only
rows matching a restricted where clause. Another (probably better) way
to support indices would be to fetch index entries at first and have
an interface to the table fetching lines based on an index key.
=head4 Sub-Selects
In most cases queries can be re-expressed without using sub-selects. But
in any case, there are circumstances where sub-selects are required.
The first implementation will do the sub-select before the primary
statement is executed without any further optimization. Hopefully
a later version will provide better L<Performance> with some
optimization.
=head4 Query based variables
Currently the only variable I can imagine is C<ROWNUM>. More suggestions
are very welcome.
=head4 Better SQL Script support
In SQL::Statement 1.xx the function C<RUN ()> provides SQL script
execution. This function may have limitations and side effects (at least
when the executed SQL touched the same tables as the primary statement).
I plan to improve the SQL script support to remove the side effects on
the one hand and have a more flexible and easier way to execute them.
Finally it should be possible to execute a script via:
$dbh->do( join( ";", @script ) );
=head4 Trigger support
Most important when doing complicated things is having callback
functions for several events. While real triggers will not be possible
for SQL::Statement and underlying pseudo-databases, callbacks could be
provided via triggers.
=head3 Performance
There are several performance optimizations required for
SQL::Statement 2.xx.
The first one should be done on a very high level (query optimization)
by implementing algebraic evaluation of queries and clean
implementation of typical database algorithms. With respect to the
basic optimization rule I<premature optimization is the root of all
evil>, it is primarily targeted to have an adequately fast, reliable
implementation of many algorithms (e.g. early incomplete evaluation to
reduce amount of rows, transpose where clause to evaluate constants
first) and a clever controller choosing the right algorithm for a
specific query.
The second optimization goal means: implementing most expensive methods
in XS. This requires a good performance test suite as well as some real
world usage cases.
=head3 Reliability
This is one of the primary goals of SQL::Statement. I hope to reach it
using test driven development and I hope I get some more todo's from the
users for this.
=head3 Extensibility
The currently high level of extensibility should be increased on a
coding level. This will be done by redesigning the entire parser and
execution engine using object oriented techniques and design patterns.
=head3 Testing
Many tests in SQL::Statement are not well organized. The tests should be
reorganized into several parts:
=over 4
=item Basic API
This part should test the entire basic API of SQL::Statement,
SQL::Parser and probably the entire engine command classes.
=item DBI / Table API
This part should test if the API to DBI drivers work (maybe an empty test
driver will be needed for that).
=item Functionality
This part should test the functionality of the SQL::Parser and the
SQL::Statement engine.
=item Performance
This part should be used to implement full usage cases (ideally from
real world projects) to allow for testing optimizations.
=back
=head1 PRIORITIES
Our priorities are localized to our current issues and proof of concept
fixes for upcoming SQL::Statement 2.xx.
Any additional priorities (as missing features, the SQL::Statement rewrite)
will come later and can be modified by (paying) users.
=head1 RESOURCES AND CONTRIBUTIONS
See L<http://dbi.perl.org/contributing> for I<how you can help>.
If your company has benefited from the DBI or SQL::Statement, please
consider if it could make a donation to The Perl Foundation
"DBI Development" or "SQL::Statement Development" fund at
L<http://dbi.perl.org/donate> to secure future development.
Alternatively, if your company would benefit from a specific new
DBI or SQL::Statement feature, please consider sponsoring its development
through the options listed in the section "Commercial Support from the
Author" on L<http://dbi.perl.org/support/>.
Using such targeted financing allows you to contribute to DBI
development (including SQL::Statement and PurePerl DBI drivers) and rapidly
get something specific and directly valuable to you in return.
Thank you.
=cut

View File

@@ -0,0 +1,369 @@
=pod
=head1 NAME
SQL::Statement::Structure - parse and examine structure of SQL queries
=head1 SYNOPSIS
use SQL::Statement;
my $sql = "SELECT a FROM b JOIN c WHERE c=? AND e=7 ORDER BY f DESC LIMIT 5,2";
my $parser = SQL::Parser->new();
$parser->{RaiseError}=1;
$parser->{PrintError}=0;
$parser->parse("LOAD 'MyLib::MySyntax' ");
my $stmt = SQL::Statement->new($sql,$parser);
printf "Command %s\n",$stmt->command;
printf "Num of Placeholders %s\n",scalar $stmt->params;
printf "Columns %s\n",join( ',', map {$_->name} $stmt->column_defs() );
printf "Tables %s\n",join( ',', map {$_->name} $stmt->tables() );
printf "Where operator %s\n",join( ',', $stmt->where->op() );
printf "Limit %s\n",$stmt->limit();
printf "Offset %s\n",$stmt->offset();
# these will work not before $stmt->execute()
printf "Order Columns %s\n",join(',', map {$_->column} $stmt->order() );
=head1 DESCRIPTION
The L<SQL::Statement> module can be used by itself, without DBI and without
a subclass to parse SQL statements and to allow you to examine the structure
of the statement (table names, column names, where clause predicates, etc.).
It will also execute statements using in-memory tables. That means that
you can create and populate some tables, then query them and fetch the
results of the queries as well as examine the differences between statement
metadata during different phases of prepare, execute, fetch. See the
remainder of this document for a description of how to create and modify
a parser object and how to use it to parse and examine SQL statements.
See L<SQL::Statement> for other uses of the module.
=head1 B<Creating a parser object>
The parser object only needs to be created once per script. It can
then be reused to parse any number of SQL statements. The basic
creation of a parser is this:
my $parser = SQL::Parser->new();
You can set the error-reporting for the parser the same way you do in DBI:
$parser->{RaiseError}=1; # turn on die-on-error behaviour
$parser->{PrinteError}=1; # turn on warnings-on-error behaviour
As with DBI, RaiseError defaults to 0 (off) and PrintError defaults to 1 (on).
For many purposes, the built-in SQL syntax should be sufficient. However, if
you need to, you can change the behaviour of the parser by extending the
supported SQL syntax either by loading a file containing definitions; or by
issuing SQL commands that modify the way the parser treats types, keywords,
functions, and operators.
$parser->parse("LOAD MyLib::MySyntax");
$parser->parse("CREATE TYPE myDataType");
See L<SQL::Statement::Syntax> for details of the supported SQL syntax and
for methods of extending the syntax.
=head1 B<Parsing SQL statements>
While you only need to define a new SQL::Parser object once per script, you
need to define a new SQL::Statment object once for each statement you want
to parse.
my $stmt = SQL::Statement->new($sql, $parser);
The call to new() takes two arguments - the SQL string you want to parse,
and the SQL::Parser object you previously created. The call to new is the
equivalent of a DBI call to prepare() - it parses the SQL into a structure
but does not attempt to execute the SQL unless you explicitly call execute().
=head1 Examining the structure of SQL statements
The following methods can be used to obtain information about a query:
=head2 B<command>
Returns the SQL command. See L<SQL::Statement::Syntax> for supported
command. Example:
my $command = $stmt->command();
=head2 B<column definitions>
my $numColumns = $stmt->column_defs(); # Scalar context
my @columnList = $stmt->column_defs(); # Array context
my($col1, $col2) = ($stmt->column_defs(0), $stmt->column_defs(1));
This method is used to retrieve column lists. The meaning depends on
the query command:
SELECT $col1, $col2, ... $colN FROM $table WHERE ...
UPDATE $table SET $col1 = $val1, $col2 = $val2, ...
$colN = $valN WHERE ...
INSERT INTO $table ($col1, $col2, ..., $colN) VALUES (...)
When used without arguments, the method returns a list of the columns
C<$col1>, C<$col2>, ..., C<$colN>, you may alternatively use a column number
as argument. Note that the column list may be empty as in
INSERT INTO $table VALUES (...)
and in I<CREATE> or I<DROP> statements.
But what does "returning a column" mean? It is returning an
C<SQL::Statement::Util::Column> instance, a class that implements the methods
C<table> and C<name>, both returning the respective scalar. For example,
consider the following statements:
INSERT INTO foo (bar) VALUES (1)
SELECT bar FROM foo WHERE ...
SELECT foo.bar FROM foo WHERE ...
In all these cases exactly one column instance would be returned with
$col->name() eq 'bar'
$col->table() eq 'foo'
=head2 B<tables>
my $tableNum = $stmt->tables(); # Scalar context
my @tables = $stmt->tables(); # Array context
my($table1, $table2) = ($stmt->tables(0), $stmt->tables(1));
Similar to C<columns>, this method returns instances of
C<SQL::Statement::Table>. For I<UPDATE>, I<DELETE>, I<INSERT>,
I<CREATE> and I<DROP>, a single table will always be returned.
I<SELECT> statements can return more than one table, in case
of joins. Table objects offer a single method, C<name> which
returns the table name.
=head2 B<params>
my $paramNum = $stmt->params(); # Scalar context
my @params = $stmt->params(); # Array context
my($p1, $p2) = ($stmt->params(0), $stmt->params(1));
The C<params> method returns information about the input parameters
used in a statement. For example, consider the following:
INSERT INTO foo VALUES (?, ?)
This would return two instances of C<SQL::Statement::Param>. Param objects
implement a single method, C<$param->num()>, which retrieves the parameter
number. (0 and 1, in the above example). As of now, not very useful ... :-)
=head2 B<row_values>
my $rowValueNum = $stmt->row_values(); # Scalar context
my @rowValues = $stmt->row_values(0); # Array context
my($rval1, $rval2) = ($stmt->row_values(0,0),
$stmt->row_values(0,1));
This method is used for statements like
UPDATE $table SET $col1 = $val1, $col2 = $val2, ...
$colN = $valN WHERE ...
INSERT INTO $table (...) VALUES ($val1, $val2, ..., $valN),
($val1, $val2, ..., $valN)
to read the values C<$val1>, C<$val2>, ... C<$valN>. It returns (lists of)
scalar values or C<SQL::Statement::Param> instances.
=head2 B<order>
my $orderNum = $stmt->order(); # Scalar context
my @order = $stmt->order(); # Array context
my($o1, $o2) = ($stmt->order(0), $stmt->order(1));
In I<SELECT> statements you can use this for looking at the ORDER clause.
Example:
SELECT * FROM FOO ORDER BY id DESC, name
In this case, C<order> could return 2 instances of C<SQL::Statement::Order>.
You can use the methods C<$o-E<gt>table()>, C<$o-E<gt>column()>,
C<$o-E<gt>direction()> and C<$o-E<gt>desc()> to examine the order object.
=head2 B<limit>
my $limit = $stmt->limit();
In a SELECT statement you can use a C<LIMIT> clause to implement
cursoring:
SELECT * FROM FOO LIMIT 5
SELECT * FROM FOO LIMIT 5, 5
SELECT * FROM FOO LIMIT 10, 5
These three statements would retrieve the rows C<0..4>, C<5..9>, C<10..14>
of the table FOO, respectively. If no C<LIMIT> clause is used, then the
method C<$stmt-E<gt>limit> returns undef. Otherwise it returns the limit
number (the maximum number of rows) from the statement (C<5> or C<10> for
the statements above).
=head2 B<offset>
my $offset = $stmt->offset();
If no C<LIMIT> clause is used, then the method C<$stmt-E<gt>limit> returns
I<undef>. Otherwise it returns the offset number (the index of the first row
to be included in the limit clause).
=head2 B<where_hash>
my $where_hash = $stmt->where_hash();
To manually evaluate the I<WHERE> clause, fetch the topmost where clause node
with the C<where_hash> method. Then evaluate the left-hand and right-hand side
of the operation, perhaps recursively. Once that is done, apply the operator
and finally negate the result, if required.
The where clause nodes have (up to) 4 attributes:
=over 12
=item op
contains the operator, one of C<AND>, C<OR>, C<=>, C<E<lt>E<gt>>, C<E<gt>=>,
C<E<gt>>, C<E<lt>=>, C<E<lt>>, C<LIKE>, C<CLIKE>, C<IS>, C<IN>, C<BETWEEN> or
a user defined operator, if any.
=item arg1
contains the left-hand side of the operator. This can be a scalar value, a
hash containing column or function definition, a parameter definition (hash has
attribute C<type> defined) or another operation (hash has attribute C<op>
defined).
=item arg2
contains the right-hand side of the operator. This can be a scalar value, a
hash containing column or function definition, a parameter definition (hash has
attribute C<type> defined) or another operation (hash has attribute C<op>
defined).
=item neg
contains a TRUE value, if the operation result must be negated after evaluation.
=back
To illustrate the above, consider the following WHERE clause:
WHERE NOT (id > 2 AND name = 'joe') OR name IS NULL
We can represent this clause by the following tree:
(id > 2) (name = 'joe')
\ /
NOT AND
\ (name IS NULL)
\ /
OR
Thus the WHERE clause would return an SQL::Statement::Op instance with
the op() field set to 'OR'. The arg2() field would return another
SQL::Statement::Op instance with arg1() being the SQL::Statement::Column
instance representing id, the arg2() field containing the value undef
(NULL) and the op() field being 'IS'.
The arg1() field of the topmost Op instance would return an Op instance
with op() eq 'AND' and neg() returning TRUE. The arg1() and arg2()
fields would be Op's representing "id > 2" and "name = 'joe'".
Of course there's a ready-for-use method for WHERE clause evaluation:
The WHERE clause evaluation depends on an object being used for
fetching parameter and column values. Usually this can be an
SQL::Statement::RAM::Table object or SQL::Eval object, but in fact it
can be any object that supplies the methods
$val = $eval->param($paramNum);
$val = $eval->column($table, $column);
Once you have such an object, you can call eval_where;
$match = $stmt->eval_where($eval);
=head2 B<where>
my $where = $stmt->where();
This method is used to examine the syntax tree of the C<WHERE> clause. It
returns I<undef> (if no C<WHERE> clause was used) or an instance of
L<SQL::Statement::Term>.
The where clause is evaluated automatically on the current selected row of
the table currently worked on when it's C<value()> method is invoked.
C<SQL::Statement> creates the object tree for where clause evaluation
directly after successfully parsing a statement from the given
C<where_clause>, if any.
=head1 Executing and fetching data from SQL statements
=head2 execute
When called from a DBD or other subclass of SQL::Statement, the execute()
method will be executed against whatever data-source (persistent storage) is
supplied by the DBD or the subclass (e.g. CSV files for L<DBD::CSV>, or
BerkeleyDB for L<DBD::DBM>). If you are using L<SQL::Statement> directly
rather than as a subclass, you can call the execute() method and the
statements will be executed() using temporary in-memory tables. When used
directly, like that, you need to create a cache hashref and pass it as the
first argument to execute:
my $cache = {};
my $parser = SQL::Parser->new();
my $stmt = SQL::Statement->new('CREATE TABLE x (id INT)',$parser);
$stmt->execute( $cache );
If you are using a statement with placeholders, those can be passed to
execute after the C<$cache>:
$stmt = SQL::Statement->new('INSERT INTO y VALUES(?,?)',$parser);
$stmt->execute( $cache, 7, 'foo' );
=head2 fetch
Only a single C<fetch()> method is provided - it returns a single row of
data as an arrayref. Use a loop to fetch all rows:
while (my $row = $stmt->fetch()) {
# ...
}
=head2 an example of executing and fetching
#!/usr/bin/perl -w
use strict;
use SQL::Statement;
my $cache={};
my $parser = SQL::Parser->new();
for my $sql(split /\n/,
" CREATE TABLE a (b INT)
INSERT INTO a VALUES(1)
INSERT INTO a VALUES(2)
SELECT MAX(b) FROM a "
)
{
$stmt = SQL::Statement->new($sql,$parser);
$stmt->execute($cache);
next unless $stmt->command eq 'SELECT';
while (my $row=$stmt->fetch)
{
print "@$row\n";
}
}
__END__
=head1 AUTHOR & COPYRIGHT
Copyright (c) 2005, Jeff Zucker <jzuckerATcpan.org>, all rights reserved.
Copyright (c) 2009-2020, Jens Rehsack <rehsackATcpan.org>, all rights reserved.
This document may be freely modified and distributed under the same terms
as Perl itself.
=cut

View File

@@ -0,0 +1,540 @@
=pod
=head1 NAME
SQL::Statement::Syntax - documentation of SQL::Statement's SQL Syntax
=head1 SYNOPSIS
See L<SQL::Statement> for usage.
=head1 DESCRIPTION
The SQL::Statement module can be used either from a DBI driver like DBD::CSV
or directly. The syntax below applies to both situations. In the case of
DBDs, each DBD can implement its own sub-dialect so be sure to check the DBD
documentation also.
SQL::Statement is meant primarily as a base class for DBD drivers
and as such concentrates on a small but useful subset of SQL.
It does *not* in any way pretend to be a complete SQL parser for
all dialects of SQL. The module will continue to add new supported syntax,
and users may also extend the syntax (see L<#Extending the SQL syntax>).
=head1 USAGE
=head2 Default Supported SQL syntax - Summary
B<SQL Statements>
CALL <function>
CREATE [TEMP] TABLE <table> <column_def_clause>
CREATE [TEMP] TABLE <table> AS <select statement>
CREATE [TEMP] TABLE <table> AS IMPORT()
CREATE FUNCTION <user_defined_function> [ NAME <perl_subroutine> ]
CREATE KEYWORD <user_defined_keyword> [ NAME <perl_subroutine> ]
CREATE OPERATOR <user_defined_operator> [ NAME <perl_subroutine> ]
CREATE TYPE <user_defined_type> [ NAME <perl_subroutine> ]
DELETE FROM <table> [<where_clause>]
DROP TABLE [IF EXISTS] <table>
DROP FUNCTION <function>
DROP KEYWORD <keyword>
DROP OPERATOR <operator>
DROP TYPE <type>
INSERT [INTO] <table> [<column_list>] VALUES <value_list>
LOAD <user_defined_functions_module>
SELECT <function>
SELECT <select_clause>
<from_clause>
[<where_clause>]
[ ORDER BY ocol1 [ASC|DESC], ... ocolN [ASC|DESC]] ]
[ GROUP BY gcol1 [, ... gcolN] ]
[ LIMIT [start,] length ]
UPDATE <table> SET <set_clause> [<where_clause>]
B<Explicit Join Qualifiers>
NATURAL, INNER, OUTER, LEFT, RIGHT, FULL
B<Built-in Functions>
* Aggregate : MIN, MAX, AVG, SUM, COUNT
* Date/Time : CURRENT_DATE, CURDATE, CURRENT_TIME, CURTIME, CURRENT_TIMESTAMP, NOW,
UNIX_TIMESTAMP
* String : ASCII, CHAR, BIT_LENGTH, CHARACTER_LENGTH, CHAR_LENGTH, COALESCE,
NVL, IFNULL, CONV, CONCAT, DECODE, HEX, OCT, BIN, INSERT, LEFT, RIGHT,
LOCATE, POSITION, LOWER, UPPER, LCASE, UCASE, LTRIM, RTRIM, OCTET_LENGTH,
REGEX, REPEAT, REPLACE, SOUNDEX, SPACE, SUBSTITUTE, SUBSTRING, SUBSTR,
TRANSLATE, TRIM, UNHEX
* Numeric : ABS, CEILING, CEIL, FLOOR, ROUND, EXP, LOG, LN, LOG10, MOD, POWER,
RAND, SIGN, SQRT, TRUNCATE, TRUNC
* Trig : ACOS, ACOSEC, ACOSECH, ACOSH, ACOT, ACOTAN, ACOTANH, ACOTH, ACSC,
ACSCH, ASEC, ASECH, ASIN, ASINH, ATAN, ATAN2, ATANH, COS, COSEC,
COSECH, COSH, COT, COTAN, COTANH, COTH, CSC, CSCH, DEG2DEG, DEG2GRAD,
DEG2RAD, DEGREES, GRAD2DEG, GRAD2GRAD, GRAD2RAD, PI, RAD2DEG, RAD2GRAD,
RAD2RAD, RADIANS, SEC, SECH, SIN, SINH, TAN, TANH
* System : DBNAME, USERNAME, USER
B<Special Utility Functions>
* IMPORT - imports a table from an external RDBMS or perl structure
* RUN - prepares and executes statements in a file of SQL statements
B<Operators and Predicates>
= , <> , < , > , <= , >= , IS [NOT] (NULL|TRUE|FALSE) , LIKE , CLIKE , IN , BETWEEN
B<Identifiers> and B<Aliases>
* regular identifiers are case insensitive (though see note on table names)
* delimited identifiers (inside double quotes) are case sensitive
* column and table aliases are supported
B<Concatenation>
* use either ANSI SQL || or the CONCAT() function
* e.g. these are the same: {foo || bar} {CONCAT(foo,bar)}
B<Comments>
* comments must occur before or after statements, cannot be embedded
* SQL-style single line -- and C-style multi-line /* */ comments are supported
B<NULLs>
* currently NULLs and empty strings are identical in non-ANSI dialect.
* use {col IS NULL} to find NULLs, not {col=''} (though both may work depending on dialect)
See below for further details.
=head2 Syntax - Details
=head3 CREATE TABLE
Creates permanent and in-memory tables.
CREATE [TEMP] TABLE <table_name> ( <column_definitions> )
CREATE [TEMP] TABLE <table_name> AS <select statement>
CREATE [TEMP] TABLE <table_name> AS IMPORT()
Column definitions are standard SQL column names, types, and
constraints, see L<Column Definitions>.
# create a permanent table
#
$dbh->do("CREATE TABLE qux (id INT PRIMARY KEY,word VARCHAR(30))");
The "AS SELECT" clause creates and populates the new table using the
data and column structure specified in the select statement.
# create and populate a table from a query to two other tables
#
$dbh->do("CREATE TABLE qux AS SELECT id,word FROM foo NATURAL JOIN bar");
If the optional keyword TEMP (or its synonym TEMPORARY) is used, the table
will be an in-memory table, available for the life of the current
database handle or until a DROP TABLE command is issued.
# create a temporary table
#
$dbh->do("CREATE TEMP TABLE qux (id INT PRIMARY KEY,word VARCHAR(30))");
TEMP tables can be modified with SQL commands but the updates are not
automatically reflected back to any permanent tables they may be
associated with. To save a TEMP table - just use an AS SELECT clause:
$dbh = DBI->connect( 'dbi:CSV:' );
$dbh->do("CREATE TEMP TABLE qux_temp AS (id INT, word VARCHAR(30))");
#
# ... modify qux_temp with INSERT, UPDATE, DELETE statements, then save it
#
$dbh->do("CREATE TABLE qux_permanent AS SELECT * FROM qux_temp");
Tables, both temporary and permanent may also be created directly from
perl arrayrefs and from heterogeneous queries to any DBI accessible
data source, see the IMPORT() function.
CREATE [ {LOCAL|GLOBAL} TEMPORARY ] TABLE $table
(
$col_1 $col_type1 $col_constraints1,
...,
$col_N $col_typeN $col_constraintsN,
)
[ ON COMMIT {DELETE|PRESERVE} ROWS ]
* col_type must be a valid data type as defined in the
"valid_data_types" section of the dialect file for the
current dialect
* col_constraints may be "PRIMARY KEY" or one or both of
"UNIQUE" and/or "NOT NULL"
* IMPORTANT NOTE: temporary tables, data types and column
constraints are checked for syntax violations but are
currently otherwise *IGNORED* -- they are recognized by
the parser, but not by the execution engine
* The following valid ANSI SQL92 options are not currently
supported: table constraints, named constraints, check
constraints, reference constraints, constraint
attributes, collations, default clauses, domain names as
data types
=head3 DROP TABLE
DROP TABLE $table [ RESTRICT | CASCADE ]
* IMPORTANT NOTE: drop behavior (cascade or restrict) is
checked for valid syntax but is otherwise *IGNORED* -- it
is recognized by the parser, but not by the execution
engine
=head3 INSERT INTO
INSERT INTO $table [ ( $col1, ..., $colN ) ] VALUES ( $val1, ... $valN )
* default values are not currently supported
* inserting from a subquery is not currently supported
=head3 DELETE FROM
DELETE FROM $table [ WHERE search_condition ]
* see "search_condition" below
=head3 UPDATE
UPDATE $table SET $col1 = $val1, ... $colN = $valN [ WHERE search_condition ]
* default values are not currently supported
* see "search_condition" below
=head3 SELECT
SELECT select_clause
FROM from_clause
[ WHERE search_condition ]
[ ORDER BY $ocol1 [ASC|DESC], ... $ocolN [ASC|DESC] ]
[ LIMIT [start,] length ]
* select clause ::=
[DISTINCT|ALL] *
| [DISTINCT|ALL] col1 [,col2, ... colN]
| set_function1 [,set_function2, ... set_functionN]
* set function ::=
COUNT ( [ALL] * )
| COUNT | MIN | MAX | AVG | SUM ( [DISTINCT|ALL] col_name )
* from clause ::=
table1 [, table2, ... tableN]
| table1 NATURAL [join_type] JOIN table2
| table1 [join_type] table2 USING (col1,col2, ... colN)
| table1 [join_type] JOIN table2 ON table1.colA = table2.colB
* join type ::=
INNER
| [OUTER] LEFT | RIGHT | FULL
* if join_type is not specified, INNER is the default
* if DISTINCT or ALL is not specified, ALL is the default
* if start position is omitted from LIMIT clause, position 0 is
the default
* ON clauses may only contain equal comparisons and AND combiners
* self-joins are not currently supported
* if implicit joins are used, the WHERE clause must contain
an equijoin condition for each table
* multiple ANSI joins are not supported; use implicit joins for these
* this also means that combinations of INNER and non-INNER joins are
not supported
=head3 SEARCH CONDITION
[NOT] $val1 $op1 $val1 [ ... AND|OR $valN $opN $valN ]
=head3 OPERATORS
$op = | <> | < | > | <= | >=
| IS [NOT] NULL | IS [NOT] TRUE | IS [NOT] FALSE
| LIKE | CLIKE | BETWEEN | IN
The "CLIKE" operator works exactly the same as the "LIKE"
operator, but is case insensitive. For example:
WHERE foo LIKE 'bar%' # succeeds if foo is "barbaz"
# fails if foo is "BARBAZ" or "Barbaz"
WHERE foo CLIKE 'bar%' # succeeds for "barbaz", "Barbaz", and "BARBAZ"
=head3 BUILT-IN AND USER-DEFINED FUNCTIONS
There are many built-in functions and you can also create your
own new functions from perl subroutines. See L<SQL::Statement::Functions>
for documentation of functions.
=head3 Identifiers (table & column names)
Regular identifiers (table and column names *without* quotes around
them) are case INSENSITIVE so column foo, fOo, FOO all refer to the
same column. Internally they are used in their lower case
representation, so do not rely on SQL::Statement retaining your case.
Delimited identifiers (table and column names *with* quotes around them) are
case SENSITIVE so column "foo", "fOo", "FOO" each refer to different columns.
A delimited identifier is *never* equal to a regular identifier (so "foo" and
foo are two different columns). But do not do that :-).
Remember thought that, in L<DBD::CSV> if table names are used directly as file
names, the case sensitivity depends on the OS e.g. on Windows files named foo,
FOO, and fOo are the same as each other while on Unix they are different.
=head3 Special Utility SQL Functions
=head4 IMPORT()
Imports the data and structure of a table from an external data source into a
permanent or temporary table.
$dbh->do("CREATE TABLE qux AS IMPORT(?)",{},$oracle_sth);
$dbh->do("CREATE TABLE qux AS IMPORT(?)",{},$AoA);
$dbh->do("CREATE TABLE qux AS IMPORT(?)",{},$AoH);
IMPORT() can also be used anywhere that table_names can:
$sth=$dbh->prepare("
SELECT * FROM IMPORT(?) AS T1 NATURAL JOIN IMPORT(?) AS T2 WHERE T1.id ...
");
$sth->execute( $pg_sth, $mysql_sth );
The IMPORT() function imports the data and structure of a table from an
external data source. The IMPORT() function is always used with a placeholder
parameter which may be 1) a prepared and executed statement handle for any DBI
accessible data source; or 2) an AoA whose first row is column names and
whose succeeding rows are data 3) an AoH.
The IMPORT() function may be used in the AS clause of a CREATE statement, and
in the FROM clause of any statement. When used in a FROM clause, it should
be used with a column alias e.g. SELECT * FROM IMPORT(?) AS TableA WHERE ...
You can also write your own IMPORT() functions to treat anything as a data
source. See User-Defined Function in L<SQL::Statement::Functions>.
Examples:
# create a CSV file from an Oracle query
#
$dbh = DBI->connect('dbi:CSV:');
$oracle_sth = $oracle_dbh->prepare($any_oracle_query);
$oracle_sth->execute(@params);
$dbh->do("CREATE TABLE qux AS IMPORT(?)",{},$oracle_sth);
# create an in-memory table from an AoA
#
$dbh = DBI->connect( 'dbi:File:' );
$arrayref = [['id','word'],[1,'foo'],[2,'bar'],];
$dbh->do("CREATE TEMP TABLE qux AS IMPORT(?)",{},$arrayref);
# query a join of a PostgreSQL table and a MySQL table
#
$dbh = DBI->connect( 'dbi:File:' );
$pg_dbh = DBI->connect( ... DBD::pg connect params );
$mysql_dbh = DBI->connect( ... DBD::mysql connect params );
$pg_sth = $pg_dbh->prepare( ... any pg query );
$pg_sth = $pg_dbh->prepare( ... any mysql query );
#
$sth=$dbh->prepare("
SELECT * FROM IMPORT(?) AS T1 NATURAL JOIN IMPORT(?) AS T2
");
$sth->execute( $pg_sth, $mysql_sth );
=head4 RUN()
Run SQL statements from a user supplied file. B<Please Note:> this
function is experimental, please let me know if you have problems.
RUN( sql_file )
If the file contains non-SELECT statements such as CREATE and INSERT, use
the RUN() function with $dbh->do(). For example, this prepares and
executes all of the SQL statements in a file called "populate.sql":
$dbh->do(" CALL RUN( 'populate.sql') ");
If the file contains SELECT statements, the RUN() function may be used
anywhere a table name may be used, for example, if you have a file called
"query.sql" containing "SELECT * FROM Employee", then these two lines
are exactly the same:
my $sth = $dbh->prepare(" SELECT * FROM Employee ");
my $sth = $dbh->prepare(" SELECT * FROM RUN( 'query.sql' ) ");
If the file contains a statement with placeholders, the values for the
placeholders can be passed in the call to $sth->execute() as normal. If the
query.sql file contains "SELECT id,name FROM x WHERE id=?", then these
two are the same:
my $sth = $dbh->prepare(" SELECT id,name FROM x WHERE id=?");
$sth->execute(64);
my $sth = $dbh->prepare(" SELECT * FROM RUN( 'query.sql' ) ");
$sth->execute(64);
B<Note> This function assumes that the SQL statements in the file are
separated by a semi-colon+newline combination (/;\n/). If you wish to use
different separators or import SQL from a different source, just override
the RUN() function with your own user-defined-function.
=head2 Further details
=over 8
=item Integers
=item Reals
Syntax obvious
=item Strings
Surrounded by either single quotes; some characters need to
be escaped with a backslash, in particular the backslash itself (\\),
the NULL byte (\0), Line feeds (\n), Carriage return (\r), and the
quotes (\').
B<Note:> Quoting "Strings" using double quotes are recognized as
quoted identifiers (column or table names).
=item Parameters
Parameters represent scalar values, like Integers, Reals and Strings
do. However, their values are read inside Execute() and not inside
Prepare(). Parameters are represented by question marks (?).
=item Identifiers
Identifiers are table or column names. Syntactically they consist of
alphabetic characters, followed by an arbitrary number of alphanumeric
characters. Identifiers like SELECT, INSERT, INTO, ORDER, BY, WHERE,
... are forbidden and reserved for other tokens. Identifiers are always
compared case-insensitively, i.e. C<select foo from bar> will be evaluated
the same as C<SELECT FOO FROM BAR> (C<FOO> will be evaluated as C<foo>,
similar for C<BAR>).
Since SQL::Statement is internally using lower cased identifiers (unquoted),
everytime a wildcard is used, the delivered names of the identifiers are
lower cased.
=back
=head1 Extending SQL syntax using SQL
The Supported SQL syntax shown above is the default for SQL::Statement but
it can be extended (or contracted) either on-the-fly or on a permanent basis.
In other words, you can modify the SQL syntax accepted as valid by the parser
and accepted as executable by the executer. There are two methods for
extending the syntax - 1) with SQL commands that can be issued directly in
SQL::Statement or form a DBD or 2) by subclassing SQL::Parser.
The following SQL commands modify the default SQL syntax:
CREATE/DROP FUNCTION
CREATE/DROP KEYWORD
CREATE/DROP TYPE
CREATE/DROP OPERATOR
A simple example would be a situation in which you have a table named
'TABLE'. Since table is an ANSI reserved key word, by default
SQL::Statement will produce an error when you attempt to create or
access it. You could put the table name inside double quotes since
quoted identifiers can validly be reserved words, or you could rename
the table. If neither of those are options, you would do this:
DROP KEYWORD table
Once that statement is issued, the parser will no longer object to 'table' as
a table name. Careful though, if you drop too many keywords you may confuse
the parser, especially keywords like FROM and WHERE that are central to
parsing the statement.
In the reverse situation, suppose you want to parse some SQL that defines a
column as type BIG_BLOB. Since 'BIG_BLOB' is not a recognized ANSI data type,
an error will be produced by default. To make the parser treat it as a valid
data type, you do this:
CREATE TYPE big_blob
Keywords and types are case-insensitive.
Suppose you are working with some SQL that contains the cosh()
function (an Oracle function for hyperbolic cosine, whatever that is
:-). The cosh() function is not currently implemented in
SQL::Statement so the parser would die with an error. But you can
easily trick the parser into accepting the function:
CREATE FUNCTION cosh
Once the parser has read that CREATE FUNCTION statement, it will no longer
object to the use of the cosh() function in SQL statements.
If your only interest is in parsing SQL statements, then C<CREATE FUNCTION
cosh> is sufficient. But if you actually want to be able to use the cosh()
function in executable statements, you need to supply a perl subroutine
that performs the cosh() function:
CREATE FUNCTION cosh AS perl_subroutine_name
The subroutine name can refer to a subroutine in your current script, or to
a subroutine in any available package. See L<SQL::Statement::Functions> for
details of how to create and load functions.
Functions can be used as predicates in search clauses, for example:
SELECT * FROM x WHERE c1=7 AND SOUNDEX(c3,'foo') AND c8='bar'
In the SQL above, the C<SOUNDEX()> function full predicate - it plays the
same role as C<c1=7 or c8='bar'>.
Functions can also serve as predicate operators. An operator, unlike a
full predicate, has something on the left and right sides. An equal sign
is an operator, so is LIKE. If you really want to you can get the parser
to not accept LIKE as an operator with
DROP OPERATOR like
Or, you can invent your own operator. Suppose you have an operator
C<REVERSE_OF> that is true if the string on its left side when reversed
is equal to the string on the right side:
CREATE OPERATOR reverse_of
SELECT * FROM x WHERE c1=7 AND c3 REVERSE_OF 'foo'
The operator could just as well have been written as a function:
CREATE FUNCTION reverse_of
SELECT * FROM x WHERE c1=7 AND REVERSE_OF(c3,'foo')
Like functions, if you want to actually execute a user-defined operator
as distinct from just parsing it, you need to assign the operator to a
perl subroutine. This is done exactly like assigning functions:
CREATE OPERATOR reverse_of AS perl_subroutine_name
=head1 Extending SQL syntax using subclasses
In addition to using the SQL shown above to modify the parser's behavior,
you can also extend the SQL syntax by subclassing SQL::Parser.
See L<SQL::Parser> for details.
=head1 AUTHOR & COPYRIGHT
Copyright (c) 2005, Jeff Zucker <jzuckerATcpan.org>, all rights reserved.
Copyright (c) 2009-2020, Jens Rehsack <rehsackATcpan.org>, all rights reserved.
This document may be freely modified and distributed under the same
terms as Perl itself.
=cut

View File

@@ -0,0 +1,249 @@
package SQL::Statement::Term;
######################################################################
#
# This module is copyright (c), 2009-2020 by Jens Rehsack.
# All rights reserved.
#
# It may be freely distributed under the same terms as Perl itself.
# See below for help and copyright information (search for SYNOPSIS).
#
######################################################################
use strict;
use warnings FATAL => "all";
our $VERSION = '1.414';
use Scalar::Util qw(weaken);
use Carp ();
=pod
=head1 NAME
SQL::Statement::Term - base class for all terms
=head1 SYNOPSIS
# create a term with an SQL::Statement object as owner
my $term = SQL::Statement::Term->new( $owner );
# access the value of that term
$term->value( $eval );
=head1 DESCRIPTION
SQL::Statement::Term is an abstract base class providing the interface
for all terms.
=head1 INHERITANCE
SQL::Statement::Term
=head1 METHODS
=head2 new
Instantiates new term and stores a weak reference to the owner.
=head2 value
I<Abstract> method which will return the value of the term. Must be
overridden by derived classes.
=head2 DESTROY
Destroys the term and undefines the weak reference to the owner.
=cut
sub new
{
my $class = $_[0];
my $owner = $_[1];
my $self = bless( { OWNER => $owner }, $class );
weaken( $self->{OWNER} );
return $self;
}
sub DESTROY
{
my $self = $_[0];
undef $self->{OWNER};
}
sub value($)
{
Carp::confess( sprintf( q{pure virtual function '%s->value' called}, ref( $_[0] ) || __PACKAGE__ ) );
}
package SQL::Statement::ConstantTerm;
use vars qw(@ISA);
@ISA = qw(SQL::Statement::Term);
=pod
=head1 NAME
SQL::Statement::ConstantTerm - term for constant values
=head1 SYNOPSIS
# create a term with an SQL::Statement object as owner
my $term = SQL::Statement::ConstantTerm->new( $owner, 'foo' );
# access the value of that term - returns 'foo'
$term->value( $eval );
=head1 DESCRIPTION
SQL::Statement::ConstantTerm implements a term which will always return the
same constant value.
=head1 INHERITANCE
SQL::Statement::ConstantTerm
ISA SQL::Statement::Term
=head1 METHODS
=head2 new
Instantiates new term and stores the constant to deliver and a weak
reference to the owner.
=head2 value
Returns the specified constant.
=cut
sub new
{
my ( $class, $owner, $value ) = @_;
my $self = $class->SUPER::new($owner);
$self->{VALUE} = $value;
return $self;
}
sub value($$) { return $_[0]->{VALUE}; }
package SQL::Statement::ColumnValue;
use vars qw(@ISA);
@ISA = qw(SQL::Statement::Term);
use Carp qw(croak);
use Params::Util qw(_INSTANCE _ARRAY0 _SCALAR);
use Scalar::Util qw(looks_like_number);
=pod
=head1 NAME
SQL::Statement::ColumnValue - term for column values
=head1 SYNOPSIS
# create a term with an SQL::Statement object as owner
my $term = SQL::Statement::ColumnValue->new( $owner, 'id' );
# access the value of that term - returns the value of the column 'id'
# of the currently active row in $eval
$term->value( $eval );
=head1 DESCRIPTION
SQL::Statement::ColumnValue implements a term which will return the specified
column of the active row.
=head1 INHERITANCE
SQL::Statement::ColumnValue
ISA SQL::Statement::Term
=head1 METHODS
=head2 new
Instantiates new term and stores the column name to deliver and a weak
reference to the owner.
=head2 value
Returns the specified column value.
=cut
sub new
{
my ( $class, $owner, $value ) = @_;
my $self = $class->SUPER::new($owner);
$self->{VALUE} = $value;
return $self;
}
sub value($)
{
my ( $self, $eval ) = @_;
unless ( defined( $self->{TMPVAL} ) )
{
my ( $tbl, $col ) = $self->{OWNER}->full_qualified_column_name( $self->{VALUE} );
defined($tbl) or croak("Can't find table containing column named '$self->{VALUE}'");
defined($col) or croak("Unknown column: '$self->{VALUE}'");
$self->{TMPVAL} = $tbl . $self->{OWNER}->{dlm} . $col;
$self->{TABLE_NAME} = $tbl;
$self->{COLUMN_NAME} = $col;
}
# XXX - can TMPVAL being defined without TABLE_NAME?
unless ( defined( $self->{TABLE_NAME} ) )
{
croak( "No table specified: '" . $self->{OWNER}->{original_string} . "'" );
}
# with TempEval: return $eval->column($self->{TABLE_NAME}, $self->{COLUMN_NAME});
my $fp;
defined( $fp = $self->{fastpath}->{ "${eval}." . $self->{TABLE_NAME} } )
and return &$fp( $self->{COLUMN_NAME} );
defined( $fp = $self->{fastpath}->{ "${eval}." . $self->{TMPVAL} } )
and return &$fp( $self->{TMPVAL} );
if ( defined( _INSTANCE( $eval, 'SQL::Eval' ) ) )
{
$self->{fastpath}->{ "${eval}." . $self->{TABLE_NAME} } =
$eval->_gen_access_fastpath( $self->{TABLE_NAME} );
return &{ $self->{fastpath}->{ "${eval}." . $self->{TABLE_NAME} } }( $self->{COLUMN_NAME} );
}
elsif ( defined( _INSTANCE( $eval, 'SQL::Eval::Table' ) ) )
{
$self->{fastpath}->{ "${eval}." . $self->{TMPVAL} } =
$eval->_gen_access_fastpath( $self->{TMPVAL} );
return &{ $self->{fastpath}->{ "${eval}." . $self->{TMPVAL} } }( $self->{TMPVAL} );
# return $eval->column( $self->{TMPVAL} );
}
else
{
croak( "Unsupported table storage: '" . ref($eval) . "'" );
}
}
=head1 AUTHOR AND COPYRIGHT
Copyright (c) 2009-2020 by Jens Rehsack: rehsackATcpan.org
All rights reserved.
You may distribute this module under the terms of either the GNU
General Public License or the Artistic License, as specified in
the Perl README file.
=cut
1;

View File

@@ -0,0 +1,231 @@
package SQL::Statement::TermFactory;
######################################################################
#
# This module is copyright (c), 2009-2020 by Jens Rehsack.
# All rights reserved.
#
# It may be freely distributed under the same terms as Perl itself.
# See below for help and copyright information (search for SYNOPSIS).
#
######################################################################
use strict;
use warnings FATAL => "all";
use SQL::Statement::Term ();
use SQL::Statement::Operation ();
use SQL::Statement::Placeholder ();
use SQL::Statement::Function ();
use Data::Dumper;
use Params::Util qw(_HASH _ARRAY0 _INSTANCE);
use Scalar::Util qw(blessed weaken);
our $VERSION = '1.414';
my %oplist = (
'=' => 'Equal',
'<>' => 'NotEqual',
'AND' => 'And',
'OR' => 'Or',
'<=' => 'LowerEqual',
'>=' => 'GreaterEqual',
'<' => 'Lower',
'>' => 'Greater',
'LIKE' => 'Like',
'RLIKE' => 'Rlike',
'CLIKE' => 'Clike',
'IN' => 'Contains',
'BETWEEN' => 'Between',
'IS' => 'Is',
);
sub new
{
my ( $class, $owner ) = @_;
my $self = bless(
{
OWNER => $owner,
},
$class
);
weaken( $self->{OWNER} );
return $self;
}
my %opClasses;
sub _getOpClass($)
{
my ( $self, $op ) = @_;
unless ( defined( $opClasses{$op} ) )
{
my $opBase = 'SQL::Statement::Operation';
my $opDialect = join( '::', $opBase, $self->{OWNER}->{dialect}, $oplist{$op} );
$opClasses{$op} =
$opDialect->isa($opBase) ? $opDialect : join( '::', $opBase, $oplist{$op} );
}
return $opClasses{$op};
}
sub buildCondition
{
my ( $self, $pred ) = @_;
my $term;
if ( _ARRAY0($pred) )
{
$term = [ map { $self->buildCondition($_) } @{$pred} ];
}
elsif ( defined( $pred->{op} ) )
{
my $op = uc( $pred->{op} );
if ( $op eq 'USER_DEFINED' && !$pred->{arg2} )
{
$term = SQL::Statement::ConstantTerm->new( $self->{OWNER}, $pred->{arg1}->{value} );
}
elsif ( defined( $oplist{$op} ) )
{
my $cn = $self->_getOpClass($op);
my $left = $self->buildCondition( $pred->{arg1} );
my $right = $self->buildCondition( $pred->{arg2} );
$term = $cn->new( $self->{OWNER}, $op, $left, $right );
}
elsif ( defined( $self->{OWNER}->{opts}->{function_names}->{$op} ) )
{
my $left = $self->buildCondition( $pred->{arg1} );
my $right = $self->buildCondition( $pred->{arg2} );
$term = SQL::Statement::Function::UserFunc->new(
$self->{OWNER}, $op,
$self->{OWNER}->{opts}->{function_names}->{$op},
[ $left, $right ]
);
}
else
{
return $self->{OWNER}->do_err( sprintf( q{Unknown operation '%s'}, $pred->{op} ) );
}
if ( $pred->{neg} )
{
$term = SQL::Statement::Operation::Neg->new( $self->{OWNER}, 'NOT', $term );
}
}
elsif ( defined( $pred->{type} ) )
{
my $type = uc( $pred->{type} );
if ( $type =~ m/^(?:STRING|NUMBER|BOOLEAN)$/ )
{
$term = SQL::Statement::ConstantTerm->new( $self->{OWNER}, $pred->{value} );
}
elsif ( $type eq 'NULL' )
{
$term = SQL::Statement::ConstantTerm->new( $self->{OWNER}, undef );
}
elsif ( $type eq 'COLUMN' )
{
$term = SQL::Statement::ColumnValue->new( $self->{OWNER}, $pred->{value} );
}
elsif ( $type eq 'PLACEHOLDER' )
{
$term = SQL::Statement::Placeholder->new( $self->{OWNER}, $pred->{argnum} );
}
elsif ( $type eq 'FUNCTION' )
{
my @params = map { blessed($_) ? $_ : $self->buildCondition($_) } @{ $pred->{value} };
if ( $pred->{name} eq 'numeric_exp' )
{
$term = SQL::Statement::Function::NumericEval->new( $self->{OWNER}, $pred->{str}, \@params );
}
elsif ( $pred->{name} eq 'str_concat' )
{
$term = SQL::Statement::Function::StrConcat->new( $self->{OWNER}, \@params );
}
elsif ( $pred->{name} eq 'TRIM' )
{
$term = SQL::Statement::Function::Trim->new( $self->{OWNER}, $pred->{trim_spec}, $pred->{trim_char}, \@params );
}
elsif ( $pred->{name} eq 'SUBSTRING' )
{
my $start = $self->buildCondition( $pred->{start} );
my $length = $self->buildCondition( $pred->{length} )
if ( _HASH( $pred->{length} ) );
$term = SQL::Statement::Function::SubString->new( $self->{OWNER}, $start, $length, \@params );
}
else
{
$term = SQL::Statement::Function::UserFunc->new( $self->{OWNER}, $pred->{name}, $pred->{subname}, \@params );
}
}
else
{
return $self->{OWNER}->do_err( sprintf( q{Unknown type '%s'}, $pred->{type} ) );
}
}
elsif ( defined( _INSTANCE( $pred, 'SQL::Statement::Term' ) ) )
{
return $pred;
}
else
{
return $self->{OWNER}->do_err( sprintf( q~Unknown predicate '{%s}'~, Dumper($pred) ) );
}
return $term;
}
sub DESTROY
{
my $self = $_[0];
undef $self->{OWNER};
}
=pod
=head1 NAME
SQL::Statement::TermFactory - Factory for SQL::Statement::Term instances
=head1 SYNOPSIS
my $termFactory = SQL::Statement::TermFactory->new($stmt);
my $whereTerms = $termFactory->buildCondition( $stmt->{where_clause} );
my $col = $termFactory->buildCondition( $stmt->{col_obj}->{$name}->{content} );
=head1 DESCRIPTION
This package implements a factory to create type and operation based terms.
Those terms are used to access data from the table(s) - either when evaluating
the where clause or returning column data.
The concept of a factory can be studied in I<Design Patterns> by the Gang of
Four. The concept of using polymorphism instead of conditions is suggested by
Martin Fowler in his book I<Refactoring>.
=head1 METHODS
=head2 buildCondition
Builds a condition object from a given (part of a) where clause. This method
calls itself recursively for I<predicates>.
=head1 AUTHOR AND COPYRIGHT
Copyright (c) 2001,2005 by Jeff Zucker: jzuckerATcpan.org
Copyright (c) 2009-2020 by Jens Rehsack: rehsackATcpan.org
All rights reserved.
You may distribute this module under the terms of either the GNU
General Public License or the Artistic License, as specified in
the Perl README file.
=cut
1;

View File

@@ -0,0 +1,182 @@
package SQL::Statement::Util;
######################################################################
#
# This module is copyright (c), 2001,2005 by Jeff Zucker.
# This module is copyright (c), 2007-2020 by Jens Rehsack.
# All rights reserved.
#
# It may be freely distributed under the same terms as Perl itself.
# See below for help and copyright information (search for SYNOPSIS).
#
######################################################################
use strict;
use warnings FATAL => "all";
use vars qw($VERSION);
$VERSION = '1.414';
sub type
{
my ($self) = @_;
return 'function' if $self->isa('SQL::Statement::Util::Function');
return 'column' if $self->isa('SQL::Statement::Util::Column');
}
package SQL::Statement::Util::Column;
use vars qw(@ISA);
@ISA = qw(SQL::Statement::Util);
use Params::Util qw(_ARRAY _HASH0 _STRING);
sub new
{
my ( $class, $col_name, $table_name, $term, $display_name, $full_orig_name, $coldef ) = @_;
$display_name ||= $col_name;
if ( $col_name && ( $col_name =~ m/^((?:"[^"]+")|(?:[^.]*))\.(.*)$/ ) )
{
$table_name = $1;
$col_name = $2;
}
elsif ( defined( _ARRAY($table_name) ) && ( scalar( @{$table_name} ) == 1 ) )
{
$table_name = $table_name->[0];
}
my %instance = (
name => $col_name,
table => $table_name,
display_name => $display_name,
term => $term,
full_orig_name => $full_orig_name,
coldef => $coldef,
);
my $self = bless( \%instance, $class );
return $self;
}
sub value($) { $_[0]->{term}->value( $_[1] ); }
sub term() { $_[0]->{term} }
sub display_name() { $_[0]->{display_name} }
sub full_orig_name() { $_[0]->{full_orig_name} }
sub name() { $_[0]->{name} }
sub table() { $_[0]->{table} }
sub coldef() { $_[0]->{coldef} }
package SQL::Statement::Util::Function;
use vars qw(@ISA);
@ISA = qw(SQL::Statement::Util);
sub new
{
my ( $class, $name, $sub_name, $args ) = @_;
my ( $pkg, $sub ) = $sub_name =~ /^(.*::)([^:]+$)/;
if ( !$sub )
{
$pkg = 'main';
$sub = $sub_name;
}
$pkg = 'main' if $pkg eq '::';
$pkg =~ s/::$//;
my %newfunc = (
name => $name,
sub_name => $sub,
pkg_name => $pkg,
args => $args,
type => 'function',
);
return bless \%newfunc, $class;
}
sub name { shift->{name} }
sub pkg_name { shift->{pkg_name} }
sub sub_name { shift->{sub_name} }
sub args { shift->{args} }
sub validate
{
my ($self) = @_;
my $pkg = $self->pkg_name;
my $sub = $self->sub_name;
$pkg =~ s,::,/,g;
eval { require "$pkg.pm" }
unless $pkg eq 'SQL/Statement/Functions'
or $pkg eq 'main';
die $@ if $@;
$pkg =~ s,/,::,g;
die "Can't find subroutine $pkg" . "::$sub\n" unless $pkg->can($sub);
return 1;
}
sub run
{
use SQL::Statement::Functions;
my ($self) = shift;
my $sub = $self->sub_name;
my $pkg = $self->pkg_name;
return $pkg->$sub(@_);
}
1;
=pod
=head1 NAME
SQL::Statement::Util
=head1 SYNOPSIS
SQL::Statement::Util::Column->new($col_name, $table_name, $term, $display_name)
SQL::Statement::Util::AggregatedColumns($col_name, $table_name, $term, $display_name)
SQL::Statement::Util::Function($name, $sub_name, $args)
=head1 DESCRIPTION
This package contains three utility classes to handle deliverable columns.
=head1 INHERITANCE
SQL::Statement::Util::Column
ISA SQL::Statement::Util
SQL::Statement::Util::AggregatedColumns
ISA SQL::Statement::Util::Column
ISA SQL::Statement::Util
SQL::Statement::Util::Function
ISA SQL::Statement::Util
=begin undocumented
=head1 METHODS
=head2 type
Returns the type of the SQL::Statement::Util instance.
=end undocumented
=head1 AUTHOR & COPYRIGHT
This module is
copyright (c) 2001,2005 by Jeff Zucker and
copyright (c) 2007-2020 by Jens Rehsack.
All rights reserved.
The module may be freely distributed under the same terms as
Perl itself using either the "GPL License" or the "Artistic
License" as specified in the Perl README file.
Jeff can be reached at: jzuckerATcpan.org
Jens can be reached at: rehsackATcpan.org or via dbi-devATperl.org
=cut