diff -rbc SQL-Statement-1.33/lib/SQL/Parser.pm SQL-Statement-1.33_new/lib/SQL/Parser.pm
*** SQL-Statement-1.33/lib/SQL/Parser.pm 2011-02-01 02:06:58.000000000 -0500
--- SQL-Statement-1.33_new/lib/SQL/Parser.pm 2011-12-14 17:18:35.000000000 -0500
***************
*** 15,20 ****
--- 15,21 ----
use warnings;
use vars qw($VERSION);
use constant FUNCTION_NAMES => join( '|', qw(TRIM SUBSTRING) );
+ use constant BAREWORD_FUNCTIONS => join( '|', qw(TRIM SUBSTRING CURRENT_DATE CURDATE CURRENT_TIME CURTIME CURRENT_TIMESTAMP NOW UNIX_TIMESTAMP PI DBNAME) );
use Carp qw(carp croak);
use Params::Util qw(_ARRAY0 _ARRAY _HASH);
use Scalar::Util qw(looks_like_number);
***************
*** 1785,1791 ****
my $parens = 0;
my $pos;
my @lparens = ();
! while ( $str =~ /\G.*?((($f)\s*\()|[\(\)])/igcs )
{
if ( $1 eq ')' )
{
--- 1786,1792 ----
my $parens = 0;
my $pos;
my @lparens = ();
! while ( $str =~ /\G.*?((\b($f)\s*\()|[\(\)])/igcs )
{
if ( $1 eq ')' )
{
***************
*** 1888,1896 ****
return 1;
}
! ###################################################################
! # LITERAL ::= <quoted_string> | <question mark> | <number> | NULL
! ###################################################################
sub LITERAL
{
my ( $self, $str ) = @_;
--- 1889,1897 ----
return 1;
}
! #############################################################################
! # LITERAL ::= <quoted_string> | <question mark> | <number> | NULL/TRUE/FALSE
! #############################################################################
sub LITERAL
{
my ( $self, $str ) = @_;
***************
*** 1902,1907 ****
--- 1903,1909 ----
$str = $1 while ( $str =~ m/^\s*\(\s*(.+)\s*\)\s*$/ );
return 'null' if $str =~ m/^NULL$/i; # NULL
+ return 'boolean' if $str =~ m/^(?:TRUE|FALSE)$/i; # TRUE/FALSE
# return 'empty_string' if $str =~ /^~E~$/i; # NULL
if ( $str eq '?' )
***************
*** 2019,2025 ****
my $brackets = 0;
my $pos;
my @lbrackets = ();
! while ( $str =~ /\G.*?((($f)\s*\[)|[\[\]])/igcs )
{
if ( $1 eq ']' )
{
--- 2021,2027 ----
my $brackets = 0;
my $pos;
my @lbrackets = ();
! while ( $str =~ /\G.*?((\b($f)\s*\[)|[\[\]])/igcs )
{
if ( $1 eq ']' )
{
***************
*** 2111,2116 ****
--- 2113,2120 ----
$str = $self->undo_string_funcs($str);
$str = undo_math_funcs($str);
my $orgstr = $str;
+ my $f = FUNCTION_NAMES;
+ my $bf = BAREWORD_FUNCTIONS;
# USER-DEFINED FUNCTION
my ( $user_func_name, $user_func_args, $is_func );
***************
*** 2123,2129 ****
$user_func_args = $2;
# convert operator-like function to parenthetical format
! if ( ( $is_func = $self->is_func($user_func_name) ) && ( $user_func_args !~ m/^\(.*\)$/ ) )
{
$orgstr = $str = "$user_func_name ($user_func_args)";
}
--- 2127,2133 ----
$user_func_args = $2;
# convert operator-like function to parenthetical format
! if ( ( $is_func = $self->is_func($user_func_name) ) && ( $user_func_args !~ m/^\(.*\)$/ ) && ( $is_func =~ /^(?:$bf)$/i ) )
{
$orgstr = $str = "$user_func_name ($user_func_args)";
}
***************
*** 2136,2145 ****
$is_func = $self->is_func($user_func_name);
}
! if ( $is_func && ( uc($is_func) !~ m/(TRIM|SUBSTRING)/ ) )
{
my ( $name, $value ) = ( $user_func_name, '' );
! if ( $str =~ m/^(\S+)\s*\((.+)\)\s*$/i )
{
$name = $1;
$value = $2;
--- 2140,2154 ----
$is_func = $self->is_func($user_func_name);
}
! # BLKB
! # Limiting the parens convert shortcut, so that "SELECT LOG(1), PI" works as a
! # two functions, and "SELECT x FROM log" works as a table
! undef $is_func if ( $is_func && $is_func !~ /^(?:$bf)$/i && $str !~ m/^\S+\s*\(.*\)\s*$/ );
!
! if ( $is_func && ( uc($is_func) !~ m/^($f)$/ ) )
{
my ( $name, $value ) = ( $user_func_name, '' );
! if ( $str =~ m/^(\S+)\s*\((.*)\)\s*$/ )
{
$name = $1;
$value = $2;
***************
*** 2350,2360 ****
};
}
! # NULL, PLACEHOLDER, NUMBER
#
if ( $type = $self->LITERAL($str) )
{
undef $str if ( $type eq 'null' );
# if ($type eq 'empty_string') {
# $str = '';
--- 2359,2371 ----
};
}
! # NULL, BOOLEAN, PLACEHOLDER, NUMBER
#
if ( $type = $self->LITERAL($str) )
{
undef $str if ( $type eq 'null' );
+ $str = 1 if ( $type eq 'boolean' and $str =~ /^TRUE$/i );
+ $str = 0 if ( $type eq 'boolean' and $str =~ /^FALSE$/i );
# if ($type eq 'empty_string') {
# $str = '';
***************
*** 2456,2462 ****
my $user_func = $col_name;
$user_func =~ s/^(\S+).*$/$1/;
! if ( $col_name !~ m/(TRIM|SUBSTRING)/i )
{
undef $user_func unless ( $self->{opts}->{function_names}->{ uc $user_func } );
}
--- 2467,2473 ----
my $user_func = $col_name;
$user_func =~ s/^(\S+).*$/$1/;
! if ( $col_name !~ m/^(TRIM|SUBSTRING)$/i )
{
undef $user_func unless ( $self->{opts}->{function_names}->{ uc $user_func } );
}
***************
*** 2544,2549 ****
--- 2555,2561 ----
return $self->do_err('Dialect does not support multiple tables!');
}
+ my $bf = BAREWORD_FUNCTIONS;
my %is_table_alias;
for my $table_str (@table_names)
{
***************
*** 2577,2583 ****
$u_name =~ s/^(\S+)\s*(.*$)/$1/;
my $u_args = $2;
! if ( $u_name = $self->is_func($u_name) )
{
$u_args = " $u_args" if ($u_args);
my $u_func = $self->ROW_VALUE( $u_name . $u_args );
--- 2589,2595 ----
$u_name =~ s/^(\S+)\s*(.*$)/$1/;
my $u_args = $2;
! if ( ($u_name = $self->is_func($u_name)) && ($u_name =~ /^(?:$bf)$/i || $table =~ /^$u_name\s*\(/i) )
{
$u_args = " $u_args" if ($u_args);
my $u_func = $self->ROW_VALUE( $u_name . $u_args );
diff -rbc SQL-Statement-1.33/lib/SQL/Statement/Functions.pm SQL-Statement-1.33_new/lib/SQL/Statement/Functions.pm
*** SQL-Statement-1.33/lib/SQL/Statement/Functions.pm 2011-02-01 02:06:59.000000000 -0500
--- SQL-Statement-1.33_new/lib/SQL/Statement/Functions.pm 2011-12-16 02:07:01.000000000 -0500
***************
*** 4,12 ****
--- 4,20 ----
use strict;
use warnings;
+ no warnings 'uninitialized'; # please don't bother me with these useless warnings...
use Params::Util qw(_ARRAY0 _HASH0 _INSTANCE);
use Scalar::Util qw(looks_like_number);
+ use List::Util qw(max); # core module since Perl 5.8.0
+ use Time::HiRes qw(time); # core module since Perl 5.7.2
+ use Encode; # core module since Perl 5.7.1
+ use Math::Trig; # core module since Perl 5.004
+ use Math::BigInt # core modules since forever
+ upgrade => 'Math::BigFloat';
+ use Math::BigFloat;
=pod
***************
*** 23,35 ****
=head1 DESCRIPTION
! This module contains the built-in functions for SQL::Parser and SQL::Statement. All of the functions are also available in any DBDs that subclass those modules (e.g. DBD::CSV, DBD::DBM, DBD::File, DBD::AnyData, DBD::Excel, etc.).
This documentation covers built-in functions and also explains how to create your own functions to supplement the built-in ones. It's easy. If you create one that is generally useful, see below for how to submit it to become a built-in function.
=head1 Function syntax
! When using SQL::Statement/SQL::Parser directly to parse SQL, functions (either built-in or user-defined) may occur anywhere in a SQL statement that values, column names, table names, or predicates may occur. When using the modules through a DBD or in any other context in which the SQL is both parsed and executed, functions can occur in the same places except that they can not occur in the column selection clause of a SELECT statement that contains a FROM clause.
# valid for both parsing and executing
--- 31,43 ----
=head1 DESCRIPTION
! This module contains the built-in functions for L<SQL::Parser> and L<SQL::Statement>. All of the functions are also available in any DBDs that subclass those modules (e.g. DBD::CSV, DBD::DBM, DBD::File, DBD::AnyData, DBD::Excel, etc.).
This documentation covers built-in functions and also explains how to create your own functions to supplement the built-in ones. It's easy. If you create one that is generally useful, see below for how to submit it to become a built-in function.
=head1 Function syntax
! When using L<SQL::Statement>/L<SQL::Parser> directly to parse SQL, functions (either built-in or user-defined) may occur anywhere in a SQL statement that values, column names, table names, or predicates may occur. When using the modules through a DBD or in any other context in which the SQL is both parsed and executed, functions can occur in the same places except that they can not occur in the column selection clause of a SELECT statement that contains a FROM clause.
# valid for both parsing and executing
***************
*** 97,103 ****
More complex functions can make use of a number of arguments always passed to functions automatically. Functions always receive these values in @_:
sub FOO {
! my($self,$sth,$rowhash,@params);
}
The first argument, $self, is whatever class the function is defined in, not generally useful unless you have an entire module to support the function.
--- 105,111 ----
More complex functions can make use of a number of arguments always passed to functions automatically. Functions always receive these values in @_:
sub FOO {
! my($self,$sth,@params);
}
The first argument, $self, is whatever class the function is defined in, not generally useful unless you have an entire module to support the function.
***************
*** 105,128 ****
The second argument, $sth is the active statement handle of the current statement. Like all active statement handles it contains the current database handle in the {Database} attribute so you can have access to the database handle in any function:
sub FOO {
! my($self,$sth,$rowhash,@params);
my $dbh = $sth->{Database};
# $dbh->do( ...), etc.
}
! In actual practice you probably want to use $sth-{Database} directly rather than making a local copy, so $sth->{Database}->do(...).
!
! The third argument, $rowhash, is a reference to a hash containing the key/value pairs for the current database row the SQL is searching. This isn't relevant for something like CURRENT_TIME which isn't based on a SQL search, but here's an example of a (rather useless) UDF using $rowhash that just joins the values for the entire row with a colon:
!
! sub COLON_JOIN {
! my($self,$sth,$rowhash,@params);
! my $str = join ':', values %$rowhash;
! }
The remaining arguments, @params, are arguments passed by users to the function, either directly or with placeholders; another silly example which just returns the results of multiplying the arguments passed to it:
sub MULTIPLY {
! my($self,$sth,$rowhash,@params);
return $params[0] * $params[1];
}
--- 113,129 ----
The second argument, $sth is the active statement handle of the current statement. Like all active statement handles it contains the current database handle in the {Database} attribute so you can have access to the database handle in any function:
sub FOO {
! my($self,$sth,@params);
my $dbh = $sth->{Database};
# $dbh->do( ...), etc.
}
! In actual practice you probably want to use $sth->{Database} directly rather than making a local copy, so $sth->{Database}->do(...).
The remaining arguments, @params, are arguments passed by users to the function, either directly or with placeholders; another silly example which just returns the results of multiplying the arguments passed to it:
sub MULTIPLY {
! my($self,$sth,@params);
return $params[0] * $params[1];
}
***************
*** 174,180 ****
More complex functions might do something like scrape an RSS feed, or search a file system and put the results in AoA. For example, to search a directory with SQL:
sub Dir {
! my($self,$sth,$rowhash,$dir)=@_;
opendir D, $dir or die "'$dir':$!";
my @files = readdir D;
my $data = [[qw(fileName fileExt)]];
--- 175,181 ----
More complex functions might do something like scrape an RSS feed, or search a file system and put the results in AoA. For example, to search a directory with SQL:
sub Dir {
! my($self,$sth,$dir)=@_;
opendir D, $dir or die "'$dir':$!";
my @files = readdir D;
my $data = [[qw(fileName fileExt)]];
***************
*** 195,210 ****
=head1 Built-in Functions
=cut
use vars qw($VERSION);
! $VERSION = '1.33';
=pod
=head2 Aggregate Functions
! =head3 min, max, avg, sum, count
Aggregate functions are handled elsewhere, see L<SQL::Parser> for documentation.
--- 196,238 ----
=head1 Built-in Functions
+ =head2 SQL-92/ODBC Compatibility
+
+ All ODBC 3.0 functions are available except for the following:
+
+ ### SQL-92 / ODBC Functions
+
+ # CONVERT / CAST - Complex to implement, but a draft is in the works.
+ # DIFFERENCE - Function is not clearly defined in spec and has very limited applications
+ # EXTRACT - Contains a FROM keyword and requires rather freeform datetime/interval expression
+
+ ### ODBC 3.0 Time/Date Functions only
+
+ # DAYOFMONTH, DAYOFWEEK, DAYOFYEAR, HOUR, MINUTE, MONTH, MONTHNAME, QUARTER, SECOND, TIMESTAMPDIFF,
+ # WEEK, YEAR - Requires freeform datetime/interval expressions. In a later release, these could
+ # be implemented with the help of Date::Parse.
+
+ ODBC 3.0 functions that are implemented with differences include:
+
+ # SOUNDEX - Returns true/false, instead of a SOUNDEX code
+ # RAND - Seed value is a second parameter with a new first parameter for max limit
+ # LOG - Returns base X (or 10) log of number, not natural log. LN is used for natural log, and
+ # LOG10 is still available for standards compatibility.
+ # POSITION - Does not use 'IN' keyword; cannot be fixed as previous versions of SQL::Statement defined
+ # the function as such.
+ # REPLACE / SUBSTITUTE - Uses a regular expression string for the second parameter, replacing the last two
+ # parameters of the typical ODBC function
+
=cut
use vars qw($VERSION);
! $VERSION = '1.34';
=pod
=head2 Aggregate Functions
! =head3 MIN, MAX, AVG, SUM, COUNT
Aggregate functions are handled elsewhere, see L<SQL::Parser> for documentation.
***************
*** 212,221 ****
=head2 Date and Time Functions
! =head3 current_date, current_time, current_timestamp
!
! B<CURRENT_DATE>
# purpose : find current date
# arguments : none
--- 240,248 ----
=head2 Date and Time Functions
! These functions can be used without parentheses.
! =head3 CURRENT_DATE aka CURDATE
# purpose : find current date
# arguments : none
***************
*** 228,372 ****
my ( $sec, $min, $hour, $day, $mon, $year ) = localtime;
return sprintf( '%4s-%02s-%02s', $year + 1900, $mon + 1, $day );
}
=pod
! B<CURRENT_TIME>
# purpose : find current time
! # arguments : none
! # returns : string containing current time as hh::mm::ss
=cut
sub SQL_FUNCTION_CURRENT_TIME
{
! return sprintf( '%02s::%02s::%02s', (localtime)[ 2, 1, 0 ] );
}
=pod
! B<CURRENT_TIMESTAMP>
# purpose : find current date and time
! # arguments : none
! # returns : string containing current timestamp as yyyy-mm-dd hh::mm::ss
=cut
sub SQL_FUNCTION_CURRENT_TIMESTAMP
{
! my ( $sec, $min, $hour, $day, $mon, $year ) = localtime;
return
! sprintf( '%4s-%02s-%02s %02s::%02s::%02s', $year + 1900, $mon + 1, $day, $hour, $min, $sec );
}
=pod
! =head2 String Functions
!
! =head3 char_length, lower, position, regex, soundex, substring, trim, upper
! B<CHAR_LENGTH>
!
! # purpose : find length in characters of a string
! # arguments : a string
! # returns : a number - the length of the string in characters
=cut
! sub SQL_FUNCTION_CHAR_LENGTH
! {
! my ( $self, $owner, $str ) = @_;
! return length($str);
! }
=pod
! B<LOWER & UPPER>
! # purpose : lower-case or upper-case a string
! # arguments : a string
! # returns : the sting lower or upper cased
! =cut
! sub SQL_FUNCTION_LOWER
! {
! my ( $self, $owner, $str ) = @_;
! return lc($str);
! }
! sub SQL_FUNCTION_UPPER
! {
! my ( $self, $owner, $str ) = @_;
! return uc($str);
}
=pod
! B<POSITION>
! # purpose : find first position of a substring in a string
! # arguments : a substring and a string possibly containing the substring
! # returns : a number - the index of the substring in the string
! # or 0 if the substring doesn't occur in the sring
=cut
! sub SQL_FUNCTION_POSITION
! {
! my ( $self, $owner, $substr, $str ) = @_;
! return index( $str, $substr ) + 1;
}
=pod
! B<REGEX>
! # purpose : test if a string matches a perl regular expression
! # arguments : a string and a regex to match the string against
! # returns : boolean value of the regex match
! #
! # example : ... WHERE REGEX(col3,'/^fun/i') ... matches rows
! # in which col3 starts with "fun", ignoring case
=cut
! sub SQL_FUNCTION_REGEX
{
! my ( $self, $owner, @params ) = @_;
! return 0 unless ( defined( $params[0] ) && defined( $params[1] ) );
! my ( $pattern, $modifier ) = $params[1] =~ m~^/(.+)/([a-z]*)$~;
! $pattern = "(?$modifier:$pattern)" if ($modifier);
! return ( $params[0] =~ qr($pattern) ) ? 1 : 0;
}
=pod
! B<SOUNDEX>
! # purpose : test if two strings have matching soundex codes
! # arguments : two strings
! # returns : true if the strings share the same soundex code
#
! # example : ... WHERE SOUNDEX(col3,'fun') ... matches rows
! # in which col3 is a soundex match for "fun"
=cut
! sub SQL_FUNCTION_SOUNDEX
{
my ( $self, $owner, @params ) = @_;
! require Text::Soundex;
! my $s1 = Text::Soundex::soundex( $params[0] ) or return 0;
! my $s2 = Text::Soundex::soundex( $params[1] ) or return 0;
! return ( $s1 eq $s2 ) ? 1 : 0;
}
=pod
! B<CONCAT>
# purpose : concatenate 1 or more strings into a single string;
# an alternative to the '||' operator
--- 255,403 ----
my ( $sec, $min, $hour, $day, $mon, $year ) = localtime;
return sprintf( '%4s-%02s-%02s', $year + 1900, $mon + 1, $day );
}
+ *SQL_FUNCTION_CURDATE = \&SQL_FUNCTION_CURRENT_DATE;
=pod
! =head3 CURRENT_TIME aka CURTIME
# purpose : find current time
! # arguments : optional seconds precision
! # returns : string containing current time as hh:mm:ss (or ss.sss...)
=cut
sub SQL_FUNCTION_CURRENT_TIME
{
! return substr(SQL_FUNCTION_CURRENT_TIMESTAMP(@_[0..2]), 11);
}
+ *SQL_FUNCTION_CURTIME = \&SQL_FUNCTION_CURRENT_TIME;
=pod
! =head3 CURRENT_TIMESTAMP aka NOW
# purpose : find current date and time
! # arguments : optional seconds precision
! # returns : string containing current timestamp as yyyy-mm-dd hh:mm:ss (or ss.sss...)
=cut
sub SQL_FUNCTION_CURRENT_TIMESTAMP
{
! my $prec = int($_[2]);
!
! my $curtime = time;
! my ( $sec, $min, $hour, $day, $mon, $year ) = localtime($curtime);
!
! my $sec_frac;
! if ($prec) {
! $sec_frac = sprintf( '%.*f', $prec, $curtime - int($curtime) );
! $sec_frac = substr($sec_frac, 2); # truncate 0. from decimal
! }
!
return
! sprintf( '%4s-%02s-%02s %02s:%02s:%02s'.($prec ? '.%s' : ''), $year + 1900, $mon + 1, $day, $hour, $min, $sec, $sec_frac );
}
+ *SQL_FUNCTION_NOW = \&SQL_FUNCTION_CURRENT_TIMESTAMP;
=pod
! =head3 UNIX_TIMESTAMP
! # purpose : find the current time in UNIX epoch format
! # arguments : optional seconds precision (unlike the MySQL version)
! # returns : a (64-bit) number, possibly with decimals
=cut
! sub SQL_FUNCTION_UNIX_TIMESTAMP { return sprintf("%.*f", int($_[2]), time); }
=pod
! =head2 String Functions
! =head3 ASCII & CHAR
! # purpose : same as ord and chr, respectively (NULL for any NULL args)
! # arguments : string or character (or number for CHAR); CHAR can have any amount of numbers for a string
! =cut
! sub SQL_FUNCTION_ASCII { return defined $_[2] ? ord($_[2]) : undef; }
! sub SQL_FUNCTION_CHAR {
! my ( $self, $owner, @params ) = @_;
! (defined || return undef) for (@params);
! return join '', map { chr } @params;
}
=pod
! =head3 BIT_LENGTH
! # purpose : length of the string in bits
! # arguments : string
=cut
! sub SQL_FUNCTION_BIT_LENGTH {
! my @v = @_[0..1]; my $str = $_[2];
! # Number of bits on first character = INT(LOG2(ord($str)) + 1) + rest of string = OCTET_LENGTH(substr($str, 1)) * 8
! return int(SQL_FUNCTION_LOG(@v, 2, ord($str)) + 1) + SQL_FUNCTION_OCTET_LENGTH(@v, substr($str, 1)) * 8;
}
=pod
! =head3 CHARACTER_LENGTH aka CHAR_LENGTH
! # purpose : find length in characters of a string
! # arguments : a string
! # returns : a number - the length of the string in characters
=cut
! sub SQL_FUNCTION_CHAR_LENGTH
{
! my ( $self, $owner, $str ) = @_;
! return length($str);
}
+ *SQL_FUNCTION_CHARACTER_LENGTH = \&SQL_FUNCTION_CHAR_LENGTH;
=pod
! =head3 COALESCE aka NVL aka IFNULL
! # purpose : return the first non-NULL value from a list
! # arguments : 1 or more expressions
! # returns : the first expression (reading left to right)
! # which is not NULL; returns NULL if all are NULL
#
! # example : SELECT COALESCE(NULL, some_null_column, 'not null')
! # returns 'not null'
=cut
! sub SQL_FUNCTION_COALESCE
{
my ( $self, $owner, @params ) = @_;
!
! #
! # eval each expr in list until a non-null
! # is encountered, then return it
! #
! foreach (@params)
! {
! return $_
! if defined($_);
! }
! return undef;
}
+ *SQL_FUNCTION_NVL = \&SQL_FUNCTION_COALESCE;
+ *SQL_FUNCTION_IFNULL = \&SQL_FUNCTION_COALESCE;
=pod
! =head3 CONCAT
# purpose : concatenate 1 or more strings into a single string;
# an alternative to the '||' operator
***************
*** 379,432 ****
=cut
! sub SQL_FUNCTION_CONCAT
! {
my ( $self, $owner, @params ) = @_;
!
! my $str = '';
! foreach (@params)
! {
! return undef unless defined($_);
! $str .= $_;
! }
! return $str;
}
=pod
! B<COALESCE> I<aka> B<NVL>
! # purpose : return the first non-NULL value from a list
! # arguments : 1 or more expressions
! # returns : the first expression (reading left to right)
! # which is not NULL; returns NULL if all are NULL
! #
! # example : SELECT COALESCE(NULL, some_null_column, 'not null')
! # returns 'not null'
=cut
! sub SQL_FUNCTION_COALESCE
! {
! my ( $self, $owner, @params ) = @_;
! #
! # eval each expr in list until a non-null
! # is encountered, then return it
! #
! foreach (@params)
! {
! return $_
! if defined($_);
}
- return undef;
- }
! sub SQL_FUNCTION_NVL { return SQL_FUNCTION_COALESCE(@_); }
=pod
! B<DECODE>
# purpose : compare the first argument against
# succeding arguments at position 1 + 2N
--- 410,570 ----
=cut
! sub SQL_FUNCTION_CONCAT {
my ( $self, $owner, @params ) = @_;
! (defined || return undef) for (@params);
! return join '', @params;
}
=pod
! =head3 CONV
! # purpose : convert a number X from base Y to base Z (from base 2 to 92)
! # arguments : X (can by a number or string depending on the base), Y, Z (Z defaults to 10)
! # returns : either a string or number, in base Z
! # notes :
! # * Supports negative and decimal numbers
! # * Will use big numbers if it has to, so accuracy is at near absolute levels
! # * Letters are case-sensitive after base 36
! # * Base character sets are: (second set is for compatibility with base 64)
! # 2 to 62 = 0-9, A-Z, a-z
! # 62 to 92 = A-Z, a-z, 0-9, +/_=~|,;:?!@#$%^&*()<>{}[]\`'"
=cut
! sub SQL_FUNCTION_CONV {
! my ( $self, $owner, $num, $sbase, $ebase ) = @_;
! $ebase ||= 10;
!
! die "Invalid base $sbase!" unless ($sbase >= 2 && $sbase <= 92);
! die "Invalid base $ebase!" unless ($ebase >= 2 && $ebase <= 92);
!
! my ($i, $new) = (0, '');
!
! # number clean up
! $num =~ s/\s+//g;
! $new = '-' if ($num =~ s/^\-//); # negative
! $num =~ s/^0+// if ($sbase <= 62);
! $num =~ s/^A+// if ($sbase > 62);
!
! my $is_dec = ($num =~ /\./) ? 1 : 0;
! $num =~ s/0+$// if ($sbase <= 62 && $is_dec);
! $num =~ s/A+$// if ($sbase > 62 && $is_dec);
!
! # short-circuits
! return $new.$num if ($sbase == $ebase);
! return $new.$num if (length($num) == 1 && $sbase < $ebase && $sbase <= 62 && $ebase <= 62);
!
! # num of digits (power)
! my $poten_digits = int(length($num) * (log($sbase) / log(10)));
! $i = length($num)- 1;
! $i = length($1) - 1 if ($num =~ s/^(.+)\.(.+)$/$1$2/); # decimal digits
!
!
! # might have large digits
! my $use_big = $poten_digits <= 14 ? 0 : 1; # Perl's number limits are probably closer to 16 digits, but just to be safe...
! $use_big = 1;
! my (@digits, %digits, $dnum);
!
! # upgrade doesn't work as well as it should...
! no strict 'subs';
! my $big_class = $is_dec ? Math::BigFloat : Math::BigInt;
!
! # convert base Y to base 10 (with short-circuits)
! if (!$is_dec && !$use_big && $sbase == 16) { $dnum = oct('0x'.$num); }
! elsif (!$is_dec && !$use_big && $sbase == 8) { $dnum = oct('0'.$num); }
! elsif (!$is_dec && !$use_big && $sbase == 2) { $dnum = oct('0b'.$num); }
! elsif ($sbase == 10) {
! no warnings 'numeric'; # what? you think I'm adding zero on accident?
! $dnum = $use_big ? $big_class->new($num) : $num + 0;
! $dnum->accuracy($poten_digits + 16) if ($use_big);
! }
! else {
! my $dstr = ($sbase <= 62) ?
! '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz' :
! 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/_=~|,;:?!@#$%^&*()<>{}[]\`'."'\"";
! $num = uc $num if ($sbase <= 36);
!
! @digits = split //, $dstr;
! %digits = map { $digits[$_] => $_ } (0 .. $sbase - 1);
!
! $dnum = $use_big ? $big_class->new(0) : 0;
! $dnum->accuracy($poten_digits + 16) if ($use_big);
! foreach my $d ( $num =~ /./g ) {
! die "Invalid character $d in string!" unless (exists $digits{$d});
! my $v = $digits{$d};
!
! my $exp;
! if ($use_big) {
! $exp = $big_class->new($sbase);
! $exp->accuracy($poten_digits + 16);
! $dnum = $exp->bpow($i)->bmul($v)->badd($dnum);
! }
! else {
! $exp = $sbase ** $i;
! $dnum += $v * $exp;
! }
! $i--; # may go into the negative for non-ints
! }
! }
! # convert base 10 to base Z (with short-circuits)
! if (!$is_dec && !$use_big && $ebase == 16) { $new .= sprintf('%X', $dnum); }
! elsif (!$is_dec && !$use_big && $ebase == 8) { $new .= sprintf('%o', $dnum); }
! elsif (!$is_dec && !$use_big && $ebase == 2) { $new .= sprintf('%b', $dnum); }
! elsif ( $ebase == 10) { $new .= $dnum; }
! else {
! my $dstr = ($ebase <= 62) ?
! '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz' :
! 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/_-=~|,;:?!@#$%^&*()<>{}[]\`'."'\"";
! @digits = split //, $dstr;
!
! # get the largest power of Z (the highest digit)
! $i = $use_big ?
! $dnum->copy()->blog(
! $ebase,
! int($dnum->length() / 9) + 2 # (an accuracy that is a little over the potential # of integer digits within log)
! )->bfloor()->bstr() :
! int(log($dnum) / log($ebase));
!
! while ($dnum != 0 && length($new) < 255) {
! if ($i == -1) { # time to go pro...
! $use_big = 1;
! $dnum = $big_class->new($dnum);
! $dnum->accuracy(length($dnum) + 255 + 16);
}
! my ($exp, $v);
! if ($use_big) {
! $exp = $big_class->new($ebase)->bpow($i);
! $v = $dnum->copy()->bdiv($exp)->bfloor();
! }
! else {
! $exp = $ebase ** $i;
! $v = int($dnum / $exp);
! }
! $dnum -= $v * $exp; # this method is safer for fractionals
!
! $new .= '.' if ($i == -1); # decimal point
! $new .= $digits[$v];
!
! $i--; # may go into the negative for non-ints
! }
! }
!
! # Final cleanup
! $new =~ s/^(-?)0+/$1/ if ($ebase <= 62);
! $new =~ s/^(-?)A+/$1/ if ($ebase > 62);
! $new =~ s/0+$// if ($ebase <= 62 && $is_dec);
! $new =~ s/A+$// if ($ebase > 62 && $is_dec);
!
! return $new;
! }
=pod
! =head3 DECODE
# purpose : compare the first argument against
# succeding arguments at position 1 + 2N
***************
*** 460,465 ****
--- 598,604 ----
# check param list size, must be at least 4,
# and even in length
#
+ no warnings 'precedence';
die 'Invalid DECODE argument list!' unless ( ( scalar @params > 3 ) && ( $#params & 1 == 1 ) );
#
***************
*** 487,493 ****
=pod
! B<REPLACE>, B<SUBSTITUTE>
# purpose : perform perl subsitution on input string
# arguments : a string and a substitute pattern string
--- 626,783 ----
=pod
! =head3 INSERT
!
! # purpose : string where L characters have been deleted from STR1, beginning at S,
! # and where STR2 has been inserted into STR1, beginning at S. NULL for any NULL args.
! # arguments : STR1, S, L, STR2
!
! =cut
!
! sub SQL_FUNCTION_INSERT { # just like a 4-parameter substr in Perl
! (defined || return undef) for (@_[2..5]);
! my $str = $_[2];
! no warnings 'void';
! substr($str, $_[3]-1, $_[4], $_[5]);
! return $str;
! }
!
! =pod
!
! =head3 HEX & OCT & BIN
!
! # purpose : convert number X from decimal to hex/octal/binary; equiv. to CONV(X, 10, 16/8/2)
! # arguments : X
!
! =cut
!
! sub SQL_FUNCTION_HEX { return SQL_FUNCTION_CONV(@_[0..2], 10, 16); }
! sub SQL_FUNCTION_OCT { return SQL_FUNCTION_CONV(@_[0..2], 10, 8); }
! sub SQL_FUNCTION_BIN { return SQL_FUNCTION_CONV(@_[0..2], 10, 2); }
!
! =pod
!
! =head3 LEFT & RIGHT
!
! # purpose : leftmost or rightmost L characters in STR, or NULL for any NULL args
! # arguments : STR1, L
!
! =cut
!
! sub SQL_FUNCTION_LEFT { (defined || return undef) for (@_[2..3]); return substr($_[2], 0, $_[3]); }
! sub SQL_FUNCTION_RIGHT { (defined || return undef) for (@_[2..3]); return substr($_[2], -$_[3]); }
!
! =pod
!
! =head3 LOCATE aka POSITION
!
! # purpose : starting position (one-based) of the first occurrence of STR1
! within STR2; 0 if it doesn't occur and NULL for any NULL args
! # arguments : STR1, STR2, and an optional S (starting position to search)
!
! =cut
!
! sub SQL_FUNCTION_LOCATE {
! (defined || return undef) for (@_[2..3]);
! my ($self, $owner, $substr, $str, $s) = @_;
! $s = int($s);
! my $pos = index( substr($str, $s), $substr ) + 1;
! return $pos && $pos + $s;
! }
! *SQL_FUNCTION_POSITION = \&SQL_FUNCTION_LOCATE;
!
! =pod
!
! =head3 LOWER & UPPER aka LCASE & UCASE
!
! # purpose : lower-case or upper-case a string
! # arguments : a string
! # returns : the sting lower or upper cased
!
! =cut
!
! sub SQL_FUNCTION_LOWER
! {
! my ( $self, $owner, $str ) = @_;
! return lc($str);
! }
!
! sub SQL_FUNCTION_UPPER
! {
! my ( $self, $owner, $str ) = @_;
! return uc($str);
! }
!
! *SQL_FUNCTION_UCASE = \&SQL_FUNCTION_UPPER;
! *SQL_FUNCTION_LCASE = \&SQL_FUNCTION_LOWER;
!
! =pod
!
! =head3 LTRIM & RTRIM
!
! # purpose : left/right counterparts for TRIM
! # arguments : string
!
! =cut
!
! sub SQL_FUNCTION_LTRIM {
! my $str = $_[2];
! $str =~ s/^\s+//;
! return $str;
! }
! sub SQL_FUNCTION_RTRIM {
! my $str = $_[2];
! $str =~ s/\s+$//;
! return $str;
! }
!
! =pod
!
! =head3 OCTET_LENGTH
!
! # purpose : length of the string in bytes (not characters)
! # arguments : string
!
! =cut
!
! sub SQL_FUNCTION_OCTET_LENGTH { return length(Encode::encode_utf8($_[2])); } # per Perldoc
!
! =pod
!
! =head3 REGEX
!
! # purpose : test if a string matches a perl regular expression
! # arguments : a string and a regex to match the string against
! # returns : boolean value of the regex match
! #
! # example : ... WHERE REGEX(col3,'/^fun/i') ... matches rows
! # in which col3 starts with "fun", ignoring case
!
! =cut
!
! sub SQL_FUNCTION_REGEX
! {
! my ( $self, $owner, @params ) = @_;
! (defined || return 0) for (@params[0..1]);
! my ( $pattern, $modifier ) = $params[1] =~ m~^/(.+)/([a-z]*)$~;
! $pattern = "(?$modifier:$pattern)" if ($modifier);
! return ( $params[0] =~ qr($pattern) ) ? 1 : 0;
! }
!
! =pod
!
! =head3 REPEAT
!
! # purpose : string composed of STR1 repeated C times, or NULL for any NULL args
! # arguments : STR1, C
!
! =cut
!
! sub SQL_FUNCTION_REPEAT { (defined || return undef) for (@_[2..3]); return $_[2] x int($_[3]); }
!
! =pod
!
! =head3 REPLACE aka SUBSTITUTE
# purpose : perform perl subsitution on input string
# arguments : a string and a substitute pattern string
***************
*** 507,529 ****
eval "\$params[0]=~$params[1]";
return $@ ? undef : $params[0];
}
! sub SQL_FUNCTION_SUBSTITUTE { return SQL_FUNCTION_REPLACE(@_); }
! sub SQL_FUNCTION_SUBSTR
{
my ( $self, $owner, @params ) = @_;
! my $string = $params[0] || '';
! my $start = $params[1] || 0;
! my $offset = $params[2] || length $string;
! my $value = '';
! $value = substr( $string, $start - 1, $offset )
! if length $string >= $start - 2 + $offset;
}
=pod
! B<SUBSTRING>
SUBSTRING( string FROM start_pos [FOR length] )
--- 797,840 ----
eval "\$params[0]=~$params[1]";
return $@ ? undef : $params[0];
}
+ *SQL_FUNCTION_SUBSTITUTE = \&SQL_FUNCTION_REPLACE;
+
+ =pod
! =head3 SOUNDEX
! # purpose : test if two strings have matching soundex codes
! # arguments : two strings
! # returns : true if the strings share the same soundex code
! #
! # example : ... WHERE SOUNDEX(col3,'fun') ... matches rows
! # in which col3 is a soundex match for "fun"
!
! =cut
!
! sub SQL_FUNCTION_SOUNDEX
{
my ( $self, $owner, @params ) = @_;
! require Text::Soundex;
! my $s1 = Text::Soundex::soundex( $params[0] ) or return 0;
! my $s2 = Text::Soundex::soundex( $params[1] ) or return 0;
! return ( $s1 eq $s2 ) ? 1 : 0;
}
=pod
! =head3 SPACE
!
! # purpose : a string of spaces
! # arguments : number of spaces
!
! =cut
!
! sub SQL_FUNCTION_SPACE { return ' ' x int($_[2]); }
!
! =pod
!
! =head3 SUBSTRING
SUBSTRING( string FROM start_pos [FOR length] )
***************
*** 535,543 ****
SUBSTRING( 'foobar' FROM 4 FOR 2) # returns "ba"
! Note: The SUBSTRING function is implemented in SQL::Parser and SQL::Statement and, at the current time, can not be over-ridden.
! B<TRIM>
TRIM ( [ [LEADING|TRAILING|BOTH] ['trim_char'] FROM ] string )
--- 846,895 ----
SUBSTRING( 'foobar' FROM 4 FOR 2) # returns "ba"
! Note: The SUBSTRING function is implemented in L<SQL::Parser> and L<SQL::Statement> and, at the current time, can not be over-ridden.
!
! =head3 SUBSTR
!
! # purpose : same as SUBSTRING, except with comma-delimited params, instead of
! words (NULL for any NULL args)
! # arguments : string, start_pos, [length]
!
! =cut
!
! sub SQL_FUNCTION_SUBSTR
! {
! my ( $self, $owner, @params ) = @_;
! (defined || return undef) for (@params[0..2]);
! my $string = $params[0] || '';
! my $start = $params[1] || 0;
! my $offset = $params[2] || length $string;
! my $value = '';
! $value = substr( $string, $start - 1, $offset )
! if length $string >= $start - 2 + $offset;
! return $value;
! }
!
! =pod
!
! =head3 TRANSLATE
!
! # purpose : transliteration; replace a set of characters in a string with another
! set of characters (a la tr///), or NULL for any NULL args
! # arguments : string, string to replace, replacement string
!
! =cut
!
! sub SQL_FUNCTION_TRANSLATE {
! my ($self, $owner, $str, $oldlist, $newlist) = @_;
! $oldlist =~ s{(/\-)}{\\$1}g;
! $newlist =~ s{(/\-)}{\\$1}g;
! eval "\$str =~ tr/$oldlist/$newlist/";
! return $str;
! }
!
! =pod
! =head3 TRIM
TRIM ( [ [LEADING|TRAILING|BOTH] ['trim_char'] FROM ] string )
***************
*** 559,569 ****
TRIM( 'x' FROM str )
trims leading and trailing x's from string
! Note: The TRIM function is implemented in SQL::Parser and SQL::Statement and, at the current time, can not be over-ridden.
! =head1 Special Utility Functions
! =head2 IMPORT()
CREATE TABLE foo AS IMPORT(?) ,{},$external_executed_sth
CREATE TABLE foo AS IMPORT(?) ,{},$AoA
--- 911,1257 ----
TRIM( 'x' FROM str )
trims leading and trailing x's from string
! Note: The TRIM function is implemented in L<SQL::Parser> and L<SQL::Statement> and, at the current time, can not be over-ridden.
!
! =pod
!
! =head3 UNHEX
!
! # purpose : convert each pair of hexadecimal digits to a byte (or a Unicode character)
! # arguments : string of hex digits, with an optional encoding name of the data string
!
! =cut
!
! sub SQL_FUNCTION_UNHEX {
! my ($self, $owner, $hex, $encoding) = @_;
! return undef unless (defined $hex);
!
! $hex =~ s/\s+//g;
! $hex =~ s/[^0-9a-fA-F]+//g;
!
! my $str = '';
! foreach my $i (0 .. int((length($hex)-1) / 2)) {
! $str .= pack('C', SQL_FUNCTION_CONV($self, $owner, substr($hex, $i*2, 2), 16, 10));
! }
! return $encoding ? Encode::decode($encoding, $str, Encode::FB_WARN) : $str;
! }
!
!
! =head2 Numeric Functions
!
! =head3 ABS
!
! # purpose : find the absolute value of a given numeric expression
! # arguments : numeric expression
!
! =cut
!
! sub SQL_FUNCTION_ABS { return abs($_[2]); }
!
! =pod
!
! =head3 CEILING (aka CEIL) & FLOOR
!
! # purpose : rounds up/down to the nearest integer
! # arguments : numeric expression
!
! =cut
!
! sub SQL_FUNCTION_CEILING { my $i = int($_[2]); return $i == $_[2] ? $i : SQL_FUNCTION_ROUND(@_[0..1], $_[2] + 0.5, 0); }
! sub SQL_FUNCTION_FLOOR { my $i = int($_[2]); return $i == $_[2] ? $i : SQL_FUNCTION_ROUND(@_[0..1], $_[2] - 0.5, 0); }
! *SQL_FUNCTION_CEIL = \&SQL_FUNCTION_CEILING;
!
! =pod
!
! =head3 EXP
!
! # purpose : raise e to the power of a number
! # arguments : numeric expression
!
! =cut
!
! sub SQL_FUNCTION_EXP { return (sinh(1)+cosh(1)) ** $_[2]; } # e = sinh(X)+cosh(X)
!
! =pod
!
! =head3 LOG
!
! # purpose : base B logarithm of X
! # arguments : B, X or just one argument of X for base 10
!
! =cut
!
! sub SQL_FUNCTION_LOG { return $_[3] ? log($_[3]) / log($_[2]) : log($_[2]) / log(10); }
!
! =pod
!
! =head3 LN & LOG10
!
! # purpose : natural logarithm (base e) or base 10 of X
! # arguments : numeric expression
!
! =cut
!
! sub SQL_FUNCTION_LN { return log($_[2]); }
! sub SQL_FUNCTION_LOG10 { return SQL_FUNCTION_LOG(@_[0..2]); }
!
! =pod
!
! =head3 MOD
!
! # purpose : modulus, or remainder, left over from dividing X / Y
! # arguments : X, Y
!
! =cut
!
! sub SQL_FUNCTION_MOD { return $_[2] % $_[3]; }
!
! =pod
!
! =head3 POWER aka POW
!
! # purpose : X to the power of Y
! # arguments : X, Y
!
! =cut
!
! sub SQL_FUNCTION_POWER { return $_[2] ** $_[3]; }
! *SQL_FUNCTION_POW = \&SQL_FUNCTION_POWER;
!
! =pod
!
! =head3 RAND
!
! # purpose : random fractional number greater than or equal to 0 and less than the value of X
! # arguments : X (with optional seed value of Y)
!
! =cut
!
! sub SQL_FUNCTION_RAND { $_[3] && srand($_[3]); return rand($_[2]); }
!
! =pod
!
! =head3 ROUND
!
! # purpose : round X with Y number of decimal digits (precision)
! # arguments : X, optional Y defaults to 0
!
! =cut
!
! sub SQL_FUNCTION_ROUND { return sprintf("%.*f", int($_[3]), $_[2]); }
!
! =pod
!
! =head3 SIGN
!
! # purpose : returns -1, 0, 1, NULL for negative, 0, positive, NULL values, respectively
! # arguments : numeric expression
!
! =cut
!
! sub SQL_FUNCTION_SIGN { return defined($_[2]) ? ($_[2] <=> 0) : undef; }
!
! =pod
!
! =head3 SQRT
!
! # purpose : square root of X
! # arguments : X
!
! =cut
!
! sub SQL_FUNCTION_SQRT { return sqrt($_[2]); }
!
! =pod
!
! =head3 TRUNCATE aka TRUNC
!
! # purpose : similar to ROUND, but removes the decimal
! # arguments : X, optional Y defaults to 0
!
! =cut
!
! sub SQL_FUNCTION_TRUNCATE { my $d = 10 ** int($_[3] || 0); return sprintf("%.*f", int($_[3]), int($_[2]*$d) / $d); }
! *SQL_FUNCTION_TRUNC = \&SQL_FUNCTION_TRUNCATE;
!
! =pod
!
! =head2 Trigonometric Functions
!
! All of these functions work exactly like their counterparts in L<Math::Trig>; go there for documentation.
!
! =cut
!
! =over
!
! =item ACOS
!
! =item ACOSEC
!
! =item ACOSECH
!
! =item ACOSH
!
! =item ACOT
!
! =item ACOTAN
!
! =item ACOTANH
!
! =item ACOTH
!
! =item ACSC
! =item ACSCH
! =item ASEC
!
! =item ASECH
!
! =item ASIN
!
! =item ASINH
!
! =item ATAN
!
! =item ATANH
!
! =item COS
!
! =item COSEC
!
! =item COSECH
!
! =item COSH
!
! =item COT
!
! =item COTAN
!
! =item COTANH
!
! =item COTH
!
! =item CSC
!
! =item CSCH
!
! =item SEC
!
! =item SECH
!
! =item SIN
!
! =item SINH
!
! =item TAN
!
! =item TANH
!
! Takes a single parameter. All of L<Math::Trig>'s aliases are included.
!
! =item ATAN2
!
! The y,x version of arc tangent.
!
! =item DEG2DEG
!
! =item DEG2GRAD
!
! =item DEG2RAD
!
! Converts out-of-bounds values into its correct range.
!
! =item GRAD2DEG
!
! =item GRAD2GRAD
!
! =item GRAD2RAD
!
! =item RAD2DEG
!
! =item RAD2GRAD
!
! =item RAD2RAD
!
! Like their L<Math::Trig>'s counterparts, accepts an optional 2nd boolean parameter (like B<TRUE>) to keep prevent range wrapping.
!
! =item DEGREES
!
! =item RADIANS
!
! B<DEGREES> and B<RADIANS> are included for SQL-92 compatibility, and map to B<RAD2DEG> and B<DEG2RAD>, respectively.
!
! =item PI
!
! B<PI> can be used without parentheses.
!
! =back
!
! =cut
!
! sub SQL_FUNCTION_ACOS { return acos ($_[2] || 0); }
! sub SQL_FUNCTION_ACOSEC { return acosec ($_[2] || 0); }
! sub SQL_FUNCTION_ACOSECH { return acosech ($_[2] || 0); }
! sub SQL_FUNCTION_ACOSH { return acosh ($_[2] || 0); }
! sub SQL_FUNCTION_ACOT { return acot ($_[2] || 0); }
! sub SQL_FUNCTION_ACOTAN { return acotan ($_[2] || 0); }
! sub SQL_FUNCTION_ACOTANH { return acotanh ($_[2] || 0); }
! sub SQL_FUNCTION_ACOTH { return acoth ($_[2] || 0); }
! sub SQL_FUNCTION_ACSC { return acsc ($_[2] || 0); }
! sub SQL_FUNCTION_ACSCH { return acsch ($_[2] || 0); }
! sub SQL_FUNCTION_ASEC { return asec ($_[2] || 0); }
! sub SQL_FUNCTION_ASECH { return asech ($_[2] || 0); }
! sub SQL_FUNCTION_ASIN { return asin ($_[2] || 0); }
! sub SQL_FUNCTION_ASINH { return asinh ($_[2] || 0); }
! sub SQL_FUNCTION_ATAN { return atan ($_[2] || 0); }
! sub SQL_FUNCTION_ATAN2 { return atan2 ($_[2] || 0, $_[3] || 0); }
! sub SQL_FUNCTION_ATANH { return atanh ($_[2] || 0); }
! sub SQL_FUNCTION_COS { return cos ($_[2] || 0); }
! sub SQL_FUNCTION_COSEC { return cosec ($_[2] || 0); }
! sub SQL_FUNCTION_COSECH { return cosech ($_[2] || 0); }
! sub SQL_FUNCTION_COSH { return cosh ($_[2] || 0); }
! sub SQL_FUNCTION_COT { return cot ($_[2] || 0); }
! sub SQL_FUNCTION_COTAN { return cotan ($_[2] || 0); }
! sub SQL_FUNCTION_COTANH { return cotanh ($_[2] || 0); }
! sub SQL_FUNCTION_COTH { return coth ($_[2] || 0); }
! sub SQL_FUNCTION_CSC { return csc ($_[2] || 0); }
! sub SQL_FUNCTION_CSCH { return csch ($_[2] || 0); }
! sub SQL_FUNCTION_DEG2DEG { return deg2deg ($_[2] || 0); }
! sub SQL_FUNCTION_RAD2RAD { return rad2rad ($_[2] || 0); }
! sub SQL_FUNCTION_GRAD2GRAD { return grad2grad ($_[2] || 0); }
! sub SQL_FUNCTION_DEG2GRAD { return deg2grad ($_[2] || 0, $_[3] || 0); }
! sub SQL_FUNCTION_DEG2RAD { return deg2rad ($_[2] || 0, $_[3] || 0); }
! sub SQL_FUNCTION_DEGREES { return rad2deg ($_[2] || 0, $_[3] || 0); }
! sub SQL_FUNCTION_GRAD2DEG { return grad2deg ($_[2] || 0, $_[3] || 0); }
! sub SQL_FUNCTION_GRAD2RAD { return grad2rad ($_[2] || 0, $_[3] || 0); }
! sub SQL_FUNCTION_PI { return pi; }
! sub SQL_FUNCTION_RAD2DEG { return rad2deg ($_[2] || 0, $_[3] || 0); }
! sub SQL_FUNCTION_RAD2GRAD { return rad2grad ($_[2] || 0, $_[3] || 0); }
! sub SQL_FUNCTION_RADIANS { return deg2rad ($_[2] || 0, $_[3] || 0); }
! sub SQL_FUNCTION_SEC { return sec ($_[2] || 0); }
! sub SQL_FUNCTION_SECH { return sech ($_[2] || 0); }
! sub SQL_FUNCTION_SIN { return sin ($_[2] || 0); }
! sub SQL_FUNCTION_SINH { return sinh ($_[2] || 0); }
! sub SQL_FUNCTION_TAN { return tan ($_[2] || 0); }
! sub SQL_FUNCTION_TANH { return tanh ($_[2] || 0); }
!
! =head2 System Functions
!
! =head3 DBNAME & USERNAME (aka USER)
!
! # purpose : name of the database / username
! # arguments : none
!
! =cut
!
! sub SQL_FUNCTION_DBNAME { return $_[1]->{Database}{Name}; }
! sub SQL_FUNCTION_USERNAME { return $_[1]->{Database}{CURRENT_USER}; }
! *SQL_FUNCTION_USER = \&SQL_FUNCTION_USERNAME;
!
! =head2 Special Utility Functions
!
! =head3 IMPORT
CREATE TABLE foo AS IMPORT(?) ,{},$external_executed_sth
CREATE TABLE foo AS IMPORT(?) ,{},$AoA
***************
*** 602,611 ****
}
}
! # RUN()
! #
! # takes the name of a file containing SQL statements, runs the statements
! # see SQL::Parser for details
sub SQL_FUNCTION_RUN
{
--- 1290,1301 ----
}
}
! =head3 RUN
!
! Takes the name of a file containing SQL statements and runs the statements; see
! L<SQL::Parser> for documentation.
!
! =cut
sub SQL_FUNCTION_RUN
{
***************
*** 636,648 ****
=head1 Submitting built-in functions
! There are a few built-in functions in the SQL::Statement::Functions. If you make a generally useful UDF, why not submit it to me and have it (and your name) included with the built-in functions? Please follow the format shown in the module including a description of the arguments and return values for the function as well as an example. Send them to me at jzucker AT cpan.org with a subject line containing "built-in UDF".
Thanks in advance :-).
=head1 ACKNOWLEDGEMENTS
Dean Arnold supplied DECODE, COALESCE, REPLACE, many thanks!
=head1 AUTHOR & COPYRIGHT
--- 1326,1339 ----
=head1 Submitting built-in functions
! If you make a generally useful UDF, why not submit it to me and have it (and your name) included with the built-in functions? Please follow the format shown in the module including a description of the arguments and return values for the function as well as an example. Send them to the dbi-dev@perl.org mailing list (see L<http://dbi.perl.org>).
Thanks in advance :-).
=head1 ACKNOWLEDGEMENTS
Dean Arnold supplied DECODE, COALESCE, REPLACE, many thanks!
+ Brendan Byrd added in the Numeric/Trig/System functions and filled in the SQL92/ODBC gaps for the date/string functions.
=head1 AUTHOR & COPYRIGHT
diff -rbc SQL-Statement-1.33/lib/SQL/Statement/GetInfo.pm SQL-Statement-1.33_new/lib/SQL/Statement/GetInfo.pm
*** SQL-Statement-1.33/lib/SQL/Statement/GetInfo.pm 2011-02-01 02:06:59.000000000 -0500
--- SQL-Statement-1.33_new/lib/SQL/Statement/GetInfo.pm 2011-12-15 17:13:21.000000000 -0500
***************
*** 15,20 ****
--- 15,22 ----
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;
***************
*** 63,69 ****
,
10004 => "ISO-8859-1" # SQL_COLLATION_SEQ
,
! 87 => "N" # SQL_COLUMN_ALIAS
,
22 => 0 # SQL_CONCAT_NULL_BEHAVIOR
--- 65,71 ----
,
10004 => "ISO-8859-1" # SQL_COLLATION_SEQ
,
! 87 => "Y" # SQL_COLUMN_ALIAS
,
22 => 0 # SQL_CONCAT_NULL_BEHAVIOR
***************
*** 122,129 ****
125 => 0 # SQL_CONVERT_WLONGVARCHAR
,
126 => 0 # SQL_CONVERT_WVARCHAR
-
- #
,
74 => 2 # SQL_CORRELATION_NAME
,
--- 124,129 ----
***************
*** 137,143 ****
,
131 => 0 # SQL_CREATE_SCHEMA
,
! 132 => 1 # SQL_CREATE_TABLE
,
133 => 0 # SQL_CREATE_TRANSLATION
,
--- 137,157 ----
,
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
,
***************
*** 326,336 ****
# 14 => undef # SQL_SEARCH_PATTERN_ESCAPE
# 13 => undef # SQL_SERVER_NAME
# 94 => undef # SQL_SPECIAL_CHARACTERS
! # 155 => undef # SQL_SQL92_DATETIME_FUNCTIONS
# 156 => undef # SQL_SQL92_FOREIGN_KEY_DELETE_RULE
# 157 => undef # SQL_SQL92_FOREIGN_KEY_UPDATE_RULE
# 158 => undef # SQL_SQL92_GRANT
! # 159 => undef # SQL_SQL92_NUMERIC_VALUE_FUNCTIONS
,
160 => 0x00003E06 # SQL_SQL92_PREDICATES
--- 340,381 ----
# 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
***************
*** 370,385 ****
# SQL_SRVC_DEFAULT
# SQL_SRVC_ROW_SUBQUERY
,
! 164 => 0x000000EE # SQL_SQL92_STRING_FUNCTIONS
- # SQL_SSF_CONVERT - /* convert() string function not supported */
- # SQL_SSF_LOWER 2 + /* lower() string function SUPPORTED */
- # SQL_SSF_UPPER 4 + /* upper() string function SUPPORTED */
- # SQL_SSF_SUBSTRING 8 + /* substring() string function SUPPORTED */
- # SQL_SSF_TRANSLATE - /* translate() string function not supported */
- # SQL_SSF_TRIM_BOTH 32 + /* trim() both string function SUPPORTED */
- # SQL_SSF_TRIM_LEADING 64 + /* trim() leading string function SUPPORTED */
- # SQL_SSF_TRIM_TRAILING128+ /* trim() trailing string function SUPPORTED */
# 165 => undef # SQL_SQL92_VALUE_EXPRESSIONS
# 118 => undef # SQL_SQL_CONFORMANCE
# 166 => undef # SQL_STANDARD_CLI_CONFORMANCE
--- 415,431 ----
# 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
***************
*** 387,433 ****
# 168 => undef # SQL_STATIC_CURSOR_ATTRIBUTES2
# 83 => undef # SQL_STATIC_SENSITIVITY
,
! 50 => 0x00001C49 # 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 => undef # SQL_SYSTEM_FUNCTIONS
,
45 => "table" # SQL_TABLE_TERM
# 109 => undef # SQL_TIMEDATE_ADD_INTERVALS
# 110 => undef # SQL_TIMEDATE_DIFF_INTERVALS
! # 52 => undef # SQL_TIMEDATE_FUNCTIONS
# 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
);
--- 433,508 ----
# 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
);
diff -rbc SQL-Statement-1.33/lib/SQL/Statement/Syntax.pod SQL-Statement-1.33_new/lib/SQL/Statement/Syntax.pod
*** SQL-Statement-1.33/lib/SQL/Statement/Syntax.pod 2010-07-12 06:01:24.000000000 -0400
--- SQL-Statement-1.33_new/lib/SQL/Statement/Syntax.pod 2011-12-15 18:07:01.000000000 -0500
***************
*** 59,67 ****
B<Built-in Functions>
* Aggregate : MIN, MAX, AVG, SUM, COUNT
! * Date/Time : CURRENT_DATE, CURRENT_TIME, CURRENT_TIMESTAMP
! * String : CHAR_LENGTH, CONCAT, COALESCE, DECODE, LOWER, POSITION,
! REGEX, REPLACE, SOUNDEX, SUBSTRING, TRIM, UPPER
B<Special Utility Functions>
--- 59,79 ----
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>
diff -rbc SQL-Statement-1.33/lib/SQL/Statement/TermFactory.pm SQL-Statement-1.33_new/lib/SQL/Statement/TermFactory.pm
*** SQL-Statement-1.33/lib/SQL/Statement/TermFactory.pm 2011-02-01 02:06:59.000000000 -0500
--- SQL-Statement-1.33_new/lib/SQL/Statement/TermFactory.pm 2011-12-13 14:04:23.000000000 -0500
***************
*** 105,111 ****
elsif ( defined( $pred->{type} ) )
{
my $type = uc( $pred->{type} );
! if ( ( $type eq 'STRING' ) || ( $type eq 'NUMBER' ) )
{
$term = SQL::Statement::ConstantTerm->new( $self->{OWNER}, $pred->{value} );
}
--- 105,111 ----
elsif ( defined( $pred->{type} ) )
{
my $type = uc( $pred->{type} );
! if ( $type =~ /^(?:STRING|NUMBER|BOOLEAN)$/ )
{
$term = SQL::Statement::ConstantTerm->new( $self->{OWNER}, $pred->{value} );
}
diff -rbc SQL-Statement-1.33/lib/SQL/Statement/Term.pm SQL-Statement-1.33_new/lib/SQL/Statement/Term.pm
*** SQL-Statement-1.33/lib/SQL/Statement/Term.pm 2011-02-01 02:06:59.000000000 -0500
--- SQL-Statement-1.33_new/lib/SQL/Statement/Term.pm 2011-12-14 17:18:46.000000000 -0500
***************
*** 191,196 ****
--- 191,200 ----
$self->{COLUMN_NAME} = $col;
}
+ unless ( defined( $self->{TABLE_NAME} ) ) {
+ croak( "No table specified: '" . $self->{OWNER}->{original_string} . "'" );
+ }
+
# with TempEval: return $eval->column($self->{TABLE_NAME}, $self->{COLUMN_NAME});
if ( defined( _INSTANCE( $eval, 'SQL::Eval' ) ) )
diff -rbc SQL-Statement-1.33/lib/SQL/Statement.pm SQL-Statement-1.33_new/lib/SQL/Statement.pm
*** SQL-Statement-1.33/lib/SQL/Statement.pm 2011-02-01 02:06:55.000000000 -0500
--- SQL-Statement-1.33_new/lib/SQL/Statement.pm 2011-12-13 14:17:57.000000000 -0500
***************
*** 1603,1609 ****
{
defined( _INSTANCE( $self->{sort_spec_list}->[$n], 'SQL::Statement::Order' ) ) and next;
my ( $newcol, $direction ) = each %{ $self->{sort_spec_list}->[$n] };
! my $desc = $direction eq "DESC";
# XXX parse order by like group by and select list
$i = -2;
--- 1603,1609 ----
{
defined( _INSTANCE( $self->{sort_spec_list}->[$n], 'SQL::Statement::Order' ) ) and next;
my ( $newcol, $direction ) = each %{ $self->{sort_spec_list}->[$n] };
! my $desc = ($direction || "ASC") eq "DESC";
# XXX parse order by like group by and select list
$i = -2;
diff -rbc SQL-Statement-1.33/t/01prepare.t SQL-Statement-1.33_new/t/01prepare.t
*** SQL-Statement-1.33/t/01prepare.t 2010-10-13 17:40:20.000000000 -0400
--- SQL-Statement-1.33_new/t/01prepare.t 2011-12-15 16:18:24.000000000 -0500
***************
*** 1,6 ****
--- 1,7 ----
#!/usr/bin/perl -w
use strict;
use warnings;
+ no warnings 'uninitialized';
use lib qw(t);
use Test::More;
***************
*** 115,133 ****
SELECT * FROM foo LIMIT 5
SELECT * FROM foo LIMIT 0, 5
SELECT * FROM foo LIMIT 5, 10
/* STRING FUNCTIONS */
! SELECT * FROM foo WHERE UPPER(phrase) = 'bar'
SELECT * FROM foo WHERE LOWER(phrase) = 'bar'
! SELECT * FROM foo WHERE TRIM( str ) = 'bar'S
SELECT * FROM foo WHERE TRIM( LEADING FROM str ) = 'bar'
SELECT * FROM foo WHERE TRIM( TRAILING FROM str ) = 'bar'
SELECT * FROM foo WHERE TRIM( BOTH FROM str ) = 'bar'
SELECT * FROM foo WHERE TRIM( LEADING ';' FROM str ) = 'bar'
SELECT * FROM foo WHERE TRIM( UPPER(phrase) ) = 'bar'
SELECT * FROM foo WHERE TRIM( LOWER(phrase) ) = 'bar'
- SELECT * FROM foo WHERE blat= SUBSTRING(bar FROM 3 FOR 6)
- SELECT * FROM foo WHERE blat= SUBSTRING(bar FROM 3)
UPDATE foo SET bar='baz', bop=7, bump=bar+8, blat=SUBSTRING(bar FROM 3 FOR 6)
/* TABLE NAME ALIASES */
SELECT * FROM test as T1
SELECT * FROM test T1
--- 116,263 ----
SELECT * FROM foo LIMIT 5
SELECT * FROM foo LIMIT 0, 5
SELECT * FROM foo LIMIT 5, 10
+ /* DATE/TIME FUNCTIONS */
+ SELECT CURRENT_DATE()
+ SELECT CURRENT_TIME()
+ SELECT CURRENT_TIMESTAMP()
+ SELECT CURDATE()
+ SELECT CURTIME()
+ SELECT NOW()
+ SELECT UNIX_TIMESTAMP()
+ SELECT CURRENT_TIME(2)
+ SELECT CURRENT_TIMESTAMP(2)
+ SELECT CURTIME(2)
+ SELECT NOW(2)
+ SELECT UNIX_TIMESTAMP(2)
/* STRING FUNCTIONS */
! SELECT * FROM foo WHERE ASCII(status) = 65
! SELECT * FROM foo WHERE CHAR(code) = 'A'
! SELECT * FROM foo WHERE CHAR(chr1,chr2,chr3) = 'ABC'
! SELECT * FROM foo WHERE BIT_LENGTH(str) = 27
! SELECT * FROM foo WHERE CHARACTER_LENGTH(str) = 6
! SELECT * FROM foo WHERE CHAR_LENGTH(str) = 6
! SELECT * FROM foo WHERE COALESCE(NULL, status) = 'bar'
! SELECT * FROM foo WHERE NVL(NULL, status) = 'bar'
! SELECT * FROM foo WHERE IFNULL(NULL, status) = 'bar'
! SELECT * FROM foo WHERE CONCAT(str1, str2) = 'bar'
! SELECT * FROM foo WHERE DECODE(color,'White','W','Red','R','B') = 'W'
! SELECT * FROM foo WHERE INSERT(str1, 4, 5, str2) = 'foobarland'
! SELECT * FROM foo WHERE LEFT(phrase) = 'bar'
! SELECT * FROM foo WHERE RIGHT(phrase) = 'bar'
! SELECT * FROM foo WHERE LOCATE(str1, str2) = 2
! SELECT * FROM foo WHERE LOCATE(str1, str2, 3) = 5
! SELECT * FROM foo WHERE POSITION(str1, str2) = 2
! SELECT * FROM foo WHERE POSITION(str1, str2, 3) = 5
SELECT * FROM foo WHERE LOWER(phrase) = 'bar'
! SELECT * FROM foo WHERE UPPER(phrase) = 'BAR'
! SELECT * FROM foo WHERE LCASE(phrase) = 'BAR'
! SELECT * FROM foo WHERE UCASE(phrase) = 'bar'
! SELECT * FROM foo WHERE LTRIM(str) = 'bar'
! SELECT * FROM foo WHERE RTRIM(str) = 'bar'
! SELECT * FROM foo WHERE OCTET_LENGTH(str) = 12
! SELECT * FROM foo WHERE REGEX(phrase, '/EF/i') = TRUE
! SELECT * FROM foo WHERE REPEAT(status, 3) = 'AAA'
! SELECT * FROM foo WHERE REPLACE(phrase, 's/z(.+)ky/$1/i') = 'bar'
! SELECT * FROM foo WHERE SUBSTITUTE(phrase, 's/z(.+)ky/$1/i') = 'bar'
! SELECT * FROM foo WHERE SOUNDEX(name1, name2) = TRUE
! SELECT * FROM foo WHERE SPACE(num) = ' '
! SELECT * FROM foo WHERE blat = SUBSTRING(bar FROM 3 FOR 6)
! SELECT * FROM foo WHERE blat = SUBSTRING(bar FROM 3)
! SELECT * FROM foo WHERE blat = SUBSTR(bar, 3, 6)
! SELECT * FROM foo WHERE blat = SUBSTR(bar, 3)
! SELECT * FROM foo WHERE blat = TRANSLATE(bar, set1, set2)
! SELECT * FROM foo WHERE TRIM( str ) = 'bar'
SELECT * FROM foo WHERE TRIM( LEADING FROM str ) = 'bar'
SELECT * FROM foo WHERE TRIM( TRAILING FROM str ) = 'bar'
SELECT * FROM foo WHERE TRIM( BOTH FROM str ) = 'bar'
SELECT * FROM foo WHERE TRIM( LEADING ';' FROM str ) = 'bar'
SELECT * FROM foo WHERE TRIM( UPPER(phrase) ) = 'bar'
SELECT * FROM foo WHERE TRIM( LOWER(phrase) ) = 'bar'
UPDATE foo SET bar='baz', bop=7, bump=bar+8, blat=SUBSTRING(bar FROM 3 FOR 6)
+ /* NUMERIC FUNCTIONS */
+ SELECT * FROM bar WHERE ABS(-4) = 4
+ SELECT * FROM bar WHERE CEILING(-4.5) = -4
+ SELECT * FROM bar WHERE CEIL(-4.9) = -4
+ SELECT * FROM bar WHERE FLOOR(4.999999999999) = 4
+ SELECT * FROM bar WHERE LOG(6) = LOG10(6)
+ SELECT * FROM bar WHERE LN(1) = EXP(1)
+ SELECT * FROM bar WHERE MOD(8, 5) = 3
+ SELECT * FROM bar WHERE POWER(2, 4) = 16
+ SELECT * FROM bar WHERE POW(2, 4) = 16
+ SELECT * FROM bar WHERE RAND(2) = 0
+ SELECT * FROM bar WHERE RAND(2, UNIX_TIMESTAMP()) = 0
+ SELECT * FROM bar WHERE ROUND(4.999999999999) = 5
+ SELECT * FROM bar WHERE ROUND(4.542222222222, 1) = 4.5
+ SELECT * FROM bar WHERE SIGN(-25.5) = -1
+ SELECT * FROM bar WHERE SIGN(53645) = 1
+ SELECT * FROM bar WHERE SIGN(0) = 0
+ SELECT * FROM bar WHERE SIGN(NULL) = NULL
+ SELECT * FROM bar WHERE SQRT(64) = 8
+ SELECT * FROM bar WHERE TRUNCATE(4.999999999999) = 4
+ SELECT * FROM bar WHERE TRUNC(-4.9) = -4
+ SELECT * FROM bar WHERE TRUNCATE(4.934, 1) = 4.9
+ SELECT * FROM bar WHERE TRUNC(-4.99999, 1) = -4.9
+ /* TRIGONOMETRIC FUNCTIONS */
+ SELECT * FROM test WHERE ACOS(x)
+ SELECT * FROM test WHERE ACOSEC(x)
+ SELECT * FROM test WHERE ACOSECH(x)
+ SELECT * FROM test WHERE ACOSH(x)
+ SELECT * FROM test WHERE ACOT(x)
+ SELECT * FROM test WHERE ACOTAN(x)
+ SELECT * FROM test WHERE ACOTANH(x)
+ SELECT * FROM test WHERE ACOTH(x)
+ SELECT * FROM test WHERE ACSC(x)
+ SELECT * FROM test WHERE ACSCH(x)
+ SELECT * FROM test WHERE ASEC(x)
+ SELECT * FROM test WHERE ASECH(x)
+ SELECT * FROM test WHERE ASIN(x)
+ SELECT * FROM test WHERE ASINH(x)
+ SELECT * FROM test WHERE ATAN(x)
+ SELECT * FROM test WHERE ATAN2(y, x)
+ SELECT * FROM test WHERE ATANH(x)
+ SELECT * FROM test WHERE COS(x)
+ SELECT * FROM test WHERE COSEC(x)
+ SELECT * FROM test WHERE COSECH(x)
+ SELECT * FROM test WHERE COSH(x)
+ SELECT * FROM test WHERE COT(x)
+ SELECT * FROM test WHERE COTAN(x)
+ SELECT * FROM test WHERE COTANH(x)
+ SELECT * FROM test WHERE COTH(x)
+ SELECT * FROM test WHERE CSC(x)
+ SELECT * FROM test WHERE CSCH(x)
+ SELECT * FROM test WHERE DEG2DEG(deg)
+ SELECT * FROM test WHERE RAD2RAD(rad)
+ SELECT * FROM test WHERE GRAD2GRAD(grad)
+ SELECT * FROM test WHERE DEG2GRAD(deg)
+ SELECT * FROM test WHERE DEG2RAD(deg)
+ SELECT * FROM test WHERE GRAD2DEG(grad)
+ SELECT * FROM test WHERE GRAD2RAD(grad)
+ SELECT * FROM test WHERE RAD2DEG(rad)
+ SELECT * FROM test WHERE RAD2GRAD(rad)
+ SELECT * FROM test WHERE DEGREES(rad)
+ SELECT * FROM test WHERE RADIANS(deg)
+ SELECT * FROM test WHERE DEG2DEG(deg, TRUE)
+ SELECT * FROM test WHERE RAD2RAD(rad, TRUE)
+ SELECT * FROM test WHERE GRAD2GRAD(grad, TRUE)
+ SELECT * FROM test WHERE DEG2GRAD(deg, TRUE)
+ SELECT * FROM test WHERE DEG2RAD(deg, TRUE)
+ SELECT * FROM test WHERE GRAD2DEG(grad, TRUE)
+ SELECT * FROM test WHERE GRAD2RAD(grad, TRUE)
+ SELECT * FROM test WHERE RAD2DEG(rad, TRUE)
+ SELECT * FROM test WHERE RAD2GRAD(rad, TRUE)
+ SELECT * FROM test WHERE DEGREES(rad, TRUE)
+ SELECT * FROM test WHERE RADIANS(deg, TRUE)
+ SELECT * FROM test WHERE PI()
+ SELECT * FROM test WHERE SEC(x)
+ SELECT * FROM test WHERE SECH(x)
+ SELECT * FROM test WHERE SIN(x)
+ SELECT * FROM test WHERE SINH(x)
+ SELECT * FROM test WHERE TAN(x)
+ SELECT * FROM test WHERE TANH(x)
+ /* SYSTEM FUNCTIONS */
+ SELECT * FROM ztable WHERE DBNAME() = foobar
+ SELECT * FROM ztable WHERE USERNAME() = foobar
+ SELECT * FROM ztable WHERE USER() = foobar
/* TABLE NAME ALIASES */
SELECT * FROM test as T1
SELECT * FROM test T1
***************
*** 168,173 ****
--- 298,314 ----
ok( eval { $dbh->prepare($sql); }, "parse '$sql' using $test_dbd" ) or diag( $dbh->errstr() );
}
+ for my $sql(
+ split /\n/, <<""
+ UPDATE foo SET bar=REPEAT(status, BIT_LENGTH(str)), bop=7, bump=bar+POSITION(str1, str2), blat=SUBSTRING(bar FROM ASCII(status) FOR CHAR_LENGTH(str))
+ SELECT * FROM bar WHERE EXP(1) = SINH(1)+COSH(1)
+ SELECT * FROM bar WHERE LOG(8, 2) = LOG10(8) / LOG10(2)
+
+ ) {
+ local $TODO = "Analyze failures";
+ ok( eval { $dbh->prepare($sql); }, "parse '$sql' using $test_dbd" ) or diag( $dbh->errstr() );
+ }
+
SKIP:
{
my $sql = "SELECT a FROM b JOIN c WHERE c=? AND e=7 ORDER BY f ASC, g DESC LIMIT 5,2";
diff -rbc SQL-Statement-1.33/t/02execute.t SQL-Statement-1.33_new/t/02execute.t
*** SQL-Statement-1.33/t/02execute.t 2010-12-27 11:19:00.000000000 -0500
--- SQL-Statement-1.33_new/t/02execute.t 2011-12-14 14:52:30.000000000 -0500
***************
*** 95,101 ****
###########################
$dbh->do("CREATE FUNCTION froog");
sub froog { 99 }
! ok( '99' eq $dbh->selectrow_array("SELECT froog"), 'CREATE FUNCTION from script' );
for my $sql (
--- 95,101 ----
###########################
$dbh->do("CREATE FUNCTION froog");
sub froog { 99 }
! ok( '99' eq $dbh->selectrow_array("SELECT froog()"), 'CREATE FUNCTION from script' );
for my $sql (
***************
*** 166,172 ****
}
$dbh->do(qq{CREATE FUNCTION foofoo NAME "Foo::foo"});
$dbh->do(qq{CREATE FUNCTION foobar NAME "Foo::bar"});
! ok( 88 == $dbh->selectrow_array("SELECT foofoo"), 'CREATE FUNCTION from module' );
ok( 42 == $dbh->selectrow_array("SELECT foobar(21)"), 'CREATE FUNCTION from module with argument' );
################
--- 166,172 ----
}
$dbh->do(qq{CREATE FUNCTION foofoo NAME "Foo::foo"});
$dbh->do(qq{CREATE FUNCTION foobar NAME "Foo::bar"});
! ok( 88 == $dbh->selectrow_array("SELECT foofoo()"), 'CREATE FUNCTION from module' );
ok( 42 == $dbh->selectrow_array("SELECT foobar(21)"), 'CREATE FUNCTION from module with argument' );
################
***************
*** 179,185 ****
print $fh "package Bar; sub SQL_FUNCTION_BAR{77};1;";
close $fh;
$dbh->do("LOAD Bar");
! ok( 77 == $dbh->selectrow_array("SELECT bar"), 'LOAD FUNCTIONS' );
}
-e 'Bar.pm' and unlink 'Bar.pm';
--- 179,185 ----
print $fh "package Bar; sub SQL_FUNCTION_BAR{77};1;";
close $fh;
$dbh->do("LOAD Bar");
! ok( 77 == $dbh->selectrow_array("SELECT bar()"), 'LOAD FUNCTIONS' );
}
-e 'Bar.pm' and unlink 'Bar.pm';
diff -rbc SQL-Statement-1.33/t/06virtual.t SQL-Statement-1.33_new/t/06virtual.t
*** SQL-Statement-1.33/t/06virtual.t 2010-12-10 08:34:00.000000000 -0500
--- SQL-Statement-1.33_new/t/06virtual.t 2011-12-16 02:22:09.000000000 -0500
***************
*** 15,20 ****
--- 15,34 ----
my @massValues = map { [ $_, ( "a" .. "f" )[ int rand 6 ], int rand 10 ] } ( 1 .. 3999 );
+ # (this code shamelessly stolen from Math::Complex's t/Trig.t, with some mods to near)
+ use Math::Trig;
+ my $eps = 1e-11;
+
+ if ($^O eq 'unicos') { # See lib/Math/Complex.pm and t/lib/complex.t.
+ $eps = 1e-10;
+ }
+
+ sub near ($$$) {
+ my $d = $_[1] ? abs($_[0]/$_[1] - 1) : abs($_[0]);
+ cmp_ok($d, '<', $eps, $_[2]) or diag("near? $_[0] ~= $_[1]");
+ }
+ #
+
SKIP:
foreach my $test_dbd (@test_dbds)
{
***************
*** 100,105 ****
--- 114,120 ----
}
my @tests = (
+ ### GROUP BY Tests ###
{
test => 'GROUP BY one column',
sql => "SELECT class,SUM(sales) as foo, MAX(sales) FROM biz GROUP BY class",
***************
*** 207,212 ****
--- 222,228 ----
execute_err =>
qr/Column 'biz\.class' must appear in the GROUP BY clause or be used in an aggregate function/,
},
+ ### Aggregate Functions ###
{
test => 'SUM(bar) of empty table',
sql => "SELECT SUM(bar) FROM numbers",
***************
*** 253,277 ****
sql => "SELECT COUNT(*) FROM trick",
result => [ [2] ],
},
{
test => 'char_length',
sql => "SELECT CHAR_LENGTH('foo')",
result => [ [3] ],
},
{
! test => 'position',
! sql => "SELECT POSITION('a','bar')",
! result => [ [2] ],
},
{
! test => 'lower',
! sql => "SELECT LOWER('A')",
! result => [ ['a'] ],
},
{
! test => 'upper',
! sql => "SELECT UPPER('a')",
! result => [ ['A'] ],
},
{
test => 'concat good',
--- 269,421 ----
sql => "SELECT COUNT(*) FROM trick",
result => [ [2] ],
},
+ ### Date/Time Functions ###
+ {
+ test => 'current_date int',
+ sql => "SELECT CURRENT_DATE()",
+ result_like => qr/^\d{4}-\d{2}-\d{2}$/,
+ },
+ {
+ test => 'current_time int',
+ sql => "SELECT CURRENT_TIME",
+ result_like => qr/^\d{2}:\d{2}:\d{2}$/,
+ },
+ {
+ test => 'current_timestamp int',
+ sql => "SELECT CURRENT_TIMESTAMP()",
+ result_like => qr/^\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}$/,
+ },
+ {
+ test => 'curdate int',
+ sql => "SELECT CURDATE",
+ result_like => qr/^\d{4}-\d{2}-\d{2}$/,
+ },
+ {
+ test => 'curtime int',
+ sql => "SELECT CURTIME()",
+ result_like => qr/^\d{2}:\d{2}:\d{2}$/,
+ },
+ {
+ test => 'now int',
+ sql => "SELECT NOW",
+ result_like => qr/^\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}$/,
+ },
+ {
+ test => 'unix_timestamp int',
+ sql => "SELECT UNIX_TIMESTAMP()",
+ result_like => qr/^\d{10,}$/,
+ },
+ {
+ test => 'current_time precision',
+ sql => "SELECT CURRENT_TIME (1)",
+ result_like => qr/^\d{2}:\d{2}:\d{2}\.\d{1}$/,
+ },
+ {
+ test => 'current_timestamp precision',
+ sql => "SELECT CURRENT_TIMESTAMP (2)",
+ result_like => qr/^\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}\.\d{2}$/,
+ },
+ {
+ test => 'curtime precision',
+ sql => "SELECT CURTIME (3)",
+ result_like => qr/^\d{2}:\d{2}:\d{2}\.\d{3}$/,
+ },
+ {
+ test => 'now precision',
+ sql => "SELECT NOW(4)",
+ result_like => qr/^\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}\.\d{4}$/,
+ },
+ {
+ test => 'unix_timestamp precision',
+ sql => "SELECT UNIX_TIMESTAMP(5)",
+ result_like => qr/^\d{10,}\.\d{5}$/,
+ },
+ ### String Functions ###
+ {
+ test => 'ascii char',
+ sql => "SELECT ASCII('A')",
+ result => [ [65] ],
+ },
+ {
+ test => 'ascii str',
+ sql => "SELECT ASCII('ABC')",
+ result => [ [65] ],
+ },
+ {
+ test => 'char blank',
+ sql => "SELECT CHAR()",
+ result => [ [''] ],
+ },
+ {
+ test => 'char char',
+ sql => "SELECT CHAR(65)",
+ result => [ ['A'] ],
+ },
+ {
+ test => 'char char unicode',
+ sql => "SELECT CHAR(CONV('263A', 16))",
+ result => [ [chr(0x263a)] ],
+ },
+ {
+ test => 'char str',
+ sql => "SELECT CHAR(65,66,67)",
+ result => [ ['ABC'] ],
+ },
+ {
+ test => 'char str unicode',
+ sql => "SELECT CHAR(CONV('263A', 16), 9787, CONV('10011000111100', 2))",
+ result => [ [chr(9786).chr(9787).chr(9788)] ],
+ },
+ {
+ test => 'bit_length 6bit',
+ sql => "SELECT BIT_LENGTH(' oo')",
+ result => [ [22] ],
+ },
+ {
+ test => 'bit_length 7bit',
+ sql => "SELECT BIT_LENGTH('foo')",
+ result => [ [23] ],
+ },
+ {
+ test => 'bit_length unicode',
+ sql => "SELECT BIT_LENGTH(CHAR(9786, 9787, 9788))",
+ result => [ [62] ],
+ comment=> '14+24+24',
+ },
+ {
+ test => 'character_length',
+ sql => "SELECT CHARACTER_LENGTH('foo')",
+ result => [ [3] ],
+ },
{
test => 'char_length',
sql => "SELECT CHAR_LENGTH('foo')",
result => [ [3] ],
},
{
! test => 'character_length unicode',
! sql => "SELECT CHARACTER_LENGTH(CHAR(9786, 9787, 9788))",
! result => [ [3] ],
},
{
! test => 'char_length unicode',
! sql => "SELECT CHAR_LENGTH(CHAR(9786, 9787, 9788))",
! result => [ [3] ],
},
{
! test => 'coalesce',
! sql => "SELECT COALESCE(NULL,'z')",
! result => [ ['z'] ],
! },
! {
! test => 'nvl',
! sql => "SELECT NVL(NULL,'z')",
! result => [ ['z'] ],
! },
! {
! test => 'ifnull',
! sql => "SELECT IFNULL(NULL,'z')",
! result => [ ['z'] ],
},
{
test => 'concat good',
***************
*** 284,297 ****
result => [ [undef] ],
},
{
! test => 'coalesce',
! sql => "SELECT COALESCE(NULL,'z')",
! result => [ ['z'] ],
},
{
! test => 'nvl',
! sql => "SELECT NVL(NULL,'z')",
! result => [ ['z'] ],
},
{
test => 'decode',
--- 428,521 ----
result => [ [undef] ],
},
{
! test => 'conv 2->92',
! sql => "SELECT CONV('101 0100 1111 0111 0110 1011', 2, 92)",
! result => [ ['HN(/'] ],
},
{
! test => 'conv 2->64',
! sql => "SELECT CONV('101 0100 1111 0111 0110 1011', 2, 64)",
! result => [ ['VPdr'] ],
! },
! {
! test => 'conv 2->36',
! sql => "SELECT CONV('101 0100 1111 0111 0110 1011', 2, 36)",
! result => [ ['3BCKR'] ],
! },
! {
! test => 'conv 2->16',
! sql => "SELECT CONV('101 0100 1111 0111 0110 1011', 2, 16)",
! result => [ ['54F76B'] ],
! },
! {
! test => 'conv 2->10',
! sql => "SELECT CONV('101 0100 1111 0111 0110 1011', 2, 10)",
! result => [ [5568363] ],
! },
! {
! test => 'conv 2->8',
! sql => "SELECT CONV('101 0100 1111 0111 0110 1011', 2, 8)",
! result => [ [25173553] ],
! },
! {
! test => 'conv 2->2',
! sql => "SELECT CONV('101 0100 1111 0111 0110 1011', 2, 2)",
! result => [ ['10101001111011101101011'] ],
! },
! {
! test => 'conv base 36 short-circuit',
! sql => "SELECT CONV(-1, 2, 36)",
! result => [ [-1] ],
! },
! {
! test => 'conv base 92 short-circuit',
! sql => "SELECT CONV(-1, 2, 92)",
! result => [ ['-B'] ],
! },
! {
! test => 'conv 92->36',
! sql => "SELECT CONV('-&23ms98*&a ^.21 hjs ', 92, 36)",
! result => [ ['-K0I202KQNNWT6T.LCV70S2NKBRPR84RIHPA2JZ3N7MJ4LR6Z58UT0ASDKIG9QUDF96AGW9EY7318W1NWL28SHZ08T4DL8AA9KG59B6KNJZH4946CBLR0FRIGDZ7OB4F0WSGM9HVFR6E70FE932DYTYP46ZFOA3EZ54WIWW5Q3MH2FW8YIBN5V37CRN07A9C3VX4WZCF36BA69KI766606JE9G847RNA0NC3SKPR1CV7XRN56I5MWIZD34VUGJZ'] ],
! },
! {
! test => 'conv 2->92 fractional',
! sql => "SELECT CONV('10101001111.011101101011', 2, 92)",
! result => [ ['O:.q8J_/XAAAAAAAAAAAAAAi&)LZgh0v&7iGMl6;4,FUUC6U}gTSvQ?J,{rClk2+~AEG^2;_gG@:%hpI5M`$]UVl(nG|@x]}*lq?!G8/A?'."'".'<e%d>x-08]1<%?fOf'."'".'&%MVDNVw)B&%LLL}v*%%Hy+j*_vyJZH7gZ5lZn<&0]OrTeW$-0#cVCrOf<\61\o_`$i:Ug%3A{*&e$M|LAL{rGHiur~YYm_]7?@]d{>u#mwh/z!F=>C[9*F}Gp%+GXyNhT'] ],
! },
! {
! test => 'conv 8->64 fractional',
! sql => "SELECT CONV(2517.3553, 8, 64)",
! result => [ ['VP.dr'] ],
! },
! {
! test => 'conv 16->32 fractional',
! sql => "SELECT CONV('54F . 76B', 16, 32)",
! result => [ ['1AF.EQO'] ],
! },
! {
! test => 'conv 2->16 fractional',
! sql => "SELECT CONV('101 0100 1111.0111 0110 1011', 2, 16)",
! result => [ ['54F.76B'] ],
! },
! {
! test => 'conv 64->10 fractional',
! sql => "SELECT CONV('VP.dr', 64, 10)",
! result_near => 1359.463623046875,
! },
! {
! test => 'conv 32->8 fractional',
! sql => "SELECT CONV(' 1 A F . E Q O ', 32, 8)",
! result => [ [2517.3553] ],
! },
! {
! test => 'conv 2->2 fractional',
! sql => "SELECT CONV('101 0100 1111.0111 0110 1011', 2, 2)",
! result => [ ['10101001111.011101101011'] ],
! },
! {
! test => 'conv 32->8 big_number',
! sql => "SELECT CONV('1AF.EQO0000000000000000000000000000', 32, 8)",
! result => [ [2517.3553] ],
},
{
test => 'decode',
***************
*** 300,305 ****
--- 524,655 ----
result => [ ['B'], ['R'], ['W'] ],
},
{
+ test => 'insert good 1:1',
+ sql => "SELECT INSERT('foodieland', 4, 3, 'bar')",
+ result => [ ['foobarland'] ],
+ },
+ {
+ test => 'insert good non-1:1',
+ sql => "SELECT INSERT('foodland', 4, 1, 'bar')",
+ result => [ ['foobarland'] ],
+ },
+ {
+ test => 'insert bad 1',
+ sql => "SELECT INSERT(NULL, 4, 1, 'bar')",
+ result => [ [undef] ],
+ },
+ {
+ test => 'insert bad 2',
+ sql => "SELECT INSERT('foodland', 4, 1, NULL)",
+ result => [ [undef] ],
+ },
+ {
+ test => 'left good',
+ sql => "SELECT LEFT('foodland', 4)",
+ result => [ ['food'] ],
+ },
+ {
+ test => 'left bad 1',
+ sql => "SELECT LEFT(NULL, 4)",
+ result => [ [undef] ],
+ },
+ {
+ test => 'left bad 2',
+ sql => "SELECT LEFT('foodland', NULL)",
+ result => [ [undef] ],
+ },
+ {
+ test => 'right good',
+ sql => "SELECT RIGHT('foodland', 4)",
+ result => [ ['land'] ],
+ },
+ {
+ test => 'right bad 1',
+ sql => "SELECT RIGHT(NULL, 4)",
+ result => [ [undef] ],
+ },
+ {
+ test => 'right bad 2',
+ sql => "SELECT RIGHT('foodland', NULL)",
+ result => [ [undef] ],
+ },
+ {
+ test => 'locate 2param',
+ sql => "SELECT LOCATE('a','bar')",
+ result => [ [2] ],
+ },
+ {
+ test => 'locate 3param',
+ sql => "SELECT LOCATE('a','barafa',3)",
+ result => [ [4] ],
+ },
+ {
+ test => 'position 2param',
+ sql => "SELECT POSITION('a','bar')",
+ result => [ [2] ],
+ },
+ {
+ test => 'position 3param',
+ sql => "SELECT POSITION('a','barafa',3)",
+ result => [ [4] ],
+ },
+ {
+ test => 'lower',
+ sql => "SELECT LOWER('A')",
+ result => [ ['a'] ],
+ },
+ {
+ test => 'upper',
+ sql => "SELECT UPPER('a')",
+ result => [ ['A'] ],
+ },
+ {
+ test => 'lcase',
+ sql => "SELECT LCASE('A')",
+ result => [ ['a'] ],
+ },
+ {
+ test => 'ucase',
+ sql => "SELECT UCASE('a')",
+ result => [ ['A'] ],
+ },
+ {
+ test => 'ltrim',
+ sql => q{SELECT LTRIM(' fun ')},
+ result => [ ['fun '] ],
+ },
+ {
+ test => 'rtrim',
+ sql => q{SELECT RTRIM(' fun ')},
+ result => [ [' fun'] ],
+ },
+ {
+ test => 'octet_length',
+ sql => "SELECT OCTET_LENGTH('foo')",
+ result => [ [3] ],
+ },
+ {
+ test => 'octet_length unicode',
+ sql => "SELECT OCTET_LENGTH(CHAR(64, 169, 9786, 65572))",
+ result => [ [10] ],
+ comment=> '1+2+3+4',
+ },
+ {
+ test => 'regex match',
+ sql => "SELECT REGEX('jeff','/EF/i')",
+ result => [ [1] ],
+ },
+ {
+ test => 'regex no match',
+ sql => "SELECT REGEX('jeff','/zzz/')",
+ result => [ [0] ],
+ },
+ {
+ test => 'repeat',
+ sql => q{SELECT REPEAT('zfunkY', 3)},
+ result => [ ['zfunkYzfunkYzfunkY'] ],
+ },
+ {
test => 'replace',
sql => q{SELECT REPLACE('zfunkY','s/z(.+)ky/$1/i')},
result => [ ['fun'] ],
***************
*** 310,315 ****
--- 660,680 ----
result => [ ['fun'] ],
},
{
+ test => 'soundex match',
+ sql => "SELECT SOUNDEX('jeff','jeph')",
+ result => [ [1] ],
+ },
+ {
+ test => 'soundex no match',
+ sql => "SELECT SOUNDEX('jeff','quartz')",
+ result => [ [0] ],
+ },
+ {
+ test => 'space',
+ sql => q{SELECT SPACE(10)},
+ result => [ [' ' x 10] ],
+ },
+ {
test => 'substr',
sql => q{SELECT SUBSTR('zfunkY',2,3)},
result => [ ['fun'] ],
***************
*** 320,350 ****
result => [ ['White'] ],
},
{
! test => 'trim',
sql => q{SELECT TRIM(' fun ')},
result => [ ['fun'] ],
},
{
! test => 'soundex match',
! sql => "SELECT SOUNDEX('jeff','jeph')",
result => [ [1] ],
},
{
! test => 'soundex no match',
! sql => "SELECT SOUNDEX('jeff','quartz')",
result => [ [0] ],
},
{
! test => 'regex match',
! sql => "SELECT REGEX('jeff','/EF/i')",
result => [ [1] ],
},
{
! test => 'regex no match',
! sql => "SELECT REGEX('jeff','/zzz/')",
result => [ [0] ],
},
{
test => 'SELECT with calculation in WHERE CLAUSE',
sql =>
sprintf(
--- 685,1193 ----
result => [ ['White'] ],
},
{
! test => 'translate',
! sql => q{SELECT TRANSLATE('foobar forever', 'oae', '0@3')},
! result => [ ['f00b@r f0r3v3r'] ],
! },
! {
! test => 'trim simple',
sql => q{SELECT TRIM(' fun ')},
result => [ ['fun'] ],
},
{
! test => 'trim leading',
! todo => "Analyze why this fails; may be thinking FROM keyword is for table specs",
! sql => q{SELECT TRIM(LEADING FROM ' fun ')},
! result => [ ['fun '] ],
! },
! {
! test => 'trim trailing',
! todo => "Analyze why this fails; may be thinking FROM keyword is for table specs",
! sql => q{SELECT TRIM(TRAILING FROM ' fun ')},
! result => [ [' fun'] ],
! },
! {
! test => 'trim leading ;',
! todo => "Analyze why this fails; may be thinking FROM keyword is for table specs",
! sql => q{SELECT TRIM(LEADING ';' FROM ';;; fun ')},
! result => [ [' fun '] ],
! },
! {
! test => 'unhex str',
! sql => "SELECT UNHEX('414243')",
! result => [ ['ABC'] ],
! },
! {
! test => 'unhex str unicode',
! sql => "SELECT UNHEX('263A' || HEX(9787) || CONV('10011000111100', 2, 16), 'UCS-2')",
! result => [ [chr(9786).chr(9787).chr(9788)] ],
! },
! ### Numeric Functions ###
! {
! test => 'abs',
! sql => "SELECT ABS(-4)",
! result => [ [4] ],
! },
! {
! test => 'ceiling int',
! sql => "SELECT CEILING(5)",
! result => [ [5] ],
! },
! {
! test => 'ceiling positive',
! sql => "SELECT CEILING(4.1)",
! result => [ [5] ],
! },
! {
! test => 'ceil negative',
! sql => "SELECT CEIL(-4.5)",
! result => [ [-4] ],
! },
! {
! test => 'floor int',
! sql => "SELECT FLOOR(-5)",
! result => [ [-5] ],
! },
! {
! test => 'floor positive',
! sql => "SELECT FLOOR(4.999999999999)",
! result => [ [4] ],
! },
! {
! test => 'floor negative',
! sql => "SELECT FLOOR(-4.1)",
! result => [ [-5] ],
! },
! {
! test => 'exp',
! sql => "SELECT EXP(1)",
! result => [ [sinh(1)+cosh(1)] ],
! },
! {
! test => 'log as log10',
! sql => "SELECT LOG(6)",
! result => [ [log(6) / log(10)] ],
! },
! {
! test => 'log as log2',
! sql => "SELECT LOG(2, 32)",
! result => [ [log(32) / log(2)] ],
! },
! {
! test => 'ln',
! sql => "SELECT LN(3)",
! result => [ [log(3)] ],
! },
! {
! test => 'mod',
! sql => "SELECT MOD(8, 5)",
! result => [ [3] ],
! },
! {
! test => 'power',
! sql => "SELECT POWER(2, 4)",
! result => [ [16] ],
! },
! {
! test => 'pow',
! sql => "SELECT POW(2, 4)",
! result => [ [16] ],
! },
! {
! test => 'rand',
! sql => "SELECT FLOOR(RAND(4))",
! result_like => qr/^[0123]$|^-0$/,
! },
! {
! test => 'rand with seed',
! sql => "SELECT FLOOR(RAND(4), UNIX_TIMESTAMP())",
! result_like => qr/^-?[0123]$|^-0$/,
! },
! {
! test => 'round int',
! sql => "SELECT ROUND(4.999999999999)",
! result => [ [5] ],
! },
! {
! test => 'round tenth',
! sql => "SELECT ROUND(4.542222222222, 1)",
! result => [ [4.5] ],
! },
! {
! test => 'sign -1',
! sql => "SELECT SIGN(-25.5)",
! result => [ [-1] ],
! },
! {
! test => 'sign 1',
! sql => "SELECT SIGN(53645)",
result => [ [1] ],
},
{
! test => 'sign 0',
! sql => "SELECT SIGN(0)",
result => [ [0] ],
},
{
! test => 'sign null',
! sql => "SELECT SIGN(NULL)",
! result => [ [undef] ],
! },
! {
! test => 'sqrt',
! sql => "SELECT SQRT(64)",
! result => [ [8] ],
! },
! {
! test => 'truncate int',
! sql => "SELECT TRUNCATE(4.999999999999)",
! result => [ [4] ],
! },
! {
! test => 'trunc int',
! sql => "SELECT TRUNC(-4.9)",
! result => [ [-4] ],
! },
! {
! test => 'truncate tenth',
! sql => "SELECT TRUNCATE(4.934, 1)",
! result => [ [4.9] ],
! },
! {
! test => 'trunc int',
! sql => "SELECT TRUNC(-4.99999, 1)",
! result => [ [-4.9] ],
! },
! ### Trigonometric Functions ###
! # (this code shamelessly stolen from Math::Complex's t/Trig.t and converted to this test format)
! {
! test => 'sin',
! sql => "SELECT SIN(1)",
! result_near => 0.841470984807897,
! },
! {
! test => 'cos',
! sql => "SELECT COS(1)",
! result_near => 0.54030230586814,
! },
! {
! test => 'tan',
! sql => "SELECT TAN(1)",
! result_near => 1.5574077246549,
! },
! {
! test => 'sec',
! sql => "SELECT SEC(1)",
! result_near => 1.85081571768093,
! },
! {
! test => 'csc',
! sql => "SELECT CSC(1)",
! result_near => 1.18839510577812,
! },
! {
! test => 'cosec',
! sql => "SELECT COSEC(1)",
! result_near => 1.18839510577812,
! },
! {
! test => 'cot',
! sql => "SELECT COT(1)",
! result_near => 0.642092615934331,
! },
! {
! test => 'cotan',
! sql => "SELECT COTAN(1)",
! result_near => 0.642092615934331,
! },
! {
! test => 'asin',
! sql => "SELECT ASIN(1)",
! result_near => 1.5707963267949,
! },
! {
! test => 'acos',
! sql => "SELECT ACOS(1)",
! result => [ [0] ],
! },
! {
! test => 'atan',
! sql => "SELECT ATAN(1)",
! result_near => 0.785398163397448,
! },
! {
! test => 'asec',
! sql => "SELECT ASEC(1)",
! result => [ [0] ],
! },
! {
! test => 'acsc',
! sql => "SELECT ACSC(1)",
! result_near => 1.5707963267949,
! },
! {
! test => 'acosec',
! sql => "SELECT ACOSEC(1)",
! result_near => 1.5707963267949,
! },
! {
! test => 'acot',
! sql => "SELECT ACOT(1)",
! result_near => 0.785398163397448,
! },
! {
! test => 'acotan',
! sql => "SELECT ACOTAN(1)",
! result_near => 0.785398163397448,
! },
! {
! test => 'sinh',
! sql => "SELECT SINH(1)",
! result_near => 1.1752011936438,
! },
! {
! test => 'cosh',
! sql => "SELECT COSH(1)",
! result_near => 1.54308063481524,
! },
! {
! test => 'tanh',
! sql => "SELECT TANH(1)",
! result_near => 0.761594155955765,
! },
! {
! test => 'sech',
! sql => "SELECT SECH(1)",
! result_near => 0.648054273663885,
! },
! {
! test => 'csch',
! sql => "SELECT CSCH(1)",
! result_near => 0.850918128239322,
! },
! {
! test => 'cosech',
! sql => "SELECT COSECH(1)",
! result_near => 0.850918128239322,
! },
! {
! test => 'coth',
! sql => "SELECT COTH(1)",
! result_near => 1.31303528549933,
! },
! {
! test => 'cotanh',
! sql => "SELECT COTANH(1)",
! result_near => 1.31303528549933,
! },
! {
! test => 'asinh',
! sql => "SELECT ASINH(1)",
! result_near => 0.881373587019543,
! },
! {
! test => 'acosh',
! sql => "SELECT ACOSH(1)",
! result => [ [0] ],
! },
! {
! test => 'atanh',
! sql => "SELECT ATANH(0.9)",
! result_near => 1.47221948958322,
! },
! {
! test => 'asech',
! sql => "SELECT ASECH(0.9)", # atanh(1.0) would be an error.
! result_near => 0.467145308103262,
! },
! {
! test => 'acsch',
! sql => "SELECT ACSCH(2)",
! result_near => 0.481211825059603,
! },
! {
! test => 'acosech',
! sql => "SELECT ACOSECH(2)",
! result_near => 0.481211825059603,
! },
! {
! test => 'acoth',
! sql => "SELECT ACOTH(2)",
! result_near => 0.549306144334055,
! },
! {
! test => 'acotanh',
! sql => "SELECT ACOTANH(2)",
! result_near => 0.549306144334055,
! },
! {
! test => 'pi',
! sql => "SELECT PI",
! result_near => 3.141592653589793,
! },
! {
! test => 'atan2 to pi/2',
! sql => "SELECT ATAN2(1, 0)",
! result_near => pi/2,
! },
! {
! test => 'atan2 to pi/4',
! sql => "SELECT ATAN2(1, 1)",
! result_near => pi/4,
! },
! {
! test => 'atan2 to -3pi/4',
! sql => "SELECT ATAN2(-1, -1)",
! result_near => -3*pi/4,
! },
! {
! test => 'tan as property sin/cos',
! sql => "SELECT TAN(0.9)",
! result_near => sin(0.9) / cos(0.9),
! },
! {
! test => 'sinh 2',
! sql => "SELECT SINH(2)",
! result_near => 3.62686040784702,
! },
! {
! test => 'acsch 0.1',
! sql => "SELECT ACSCH(0.1)",
! result_near => 2.99822295029797,
! },
! {
! test => 'deg2rad',
! sql => "SELECT DEG2RAD(90)",
! result_near => pi/2,
! },
! {
! test => 'radians',
! sql => "SELECT RADIANS(90)",
! result_near => pi/2,
! },
! {
! test => 'rad2deg',
! sql => "SELECT RAD2DEG(PI)",
! result_near => 180,
! },
! {
! test => 'degrees',
! sql => "SELECT DEGREES(PI())",
! result_near => 180,
! },
! {
! test => 'deg2grad',
! sql => "SELECT DEG2GRAD(0.9)",
result => [ [1] ],
},
{
! test => 'grad2deg',
! sql => "SELECT GRAD2DEG(50)",
! result => [ [45] ],
! },
! {
! test => 'rad2grad',
! sql => "SELECT RAD2GRAD(PI / 2)",
! result => [ [200] ],
! },
! {
! test => 'grad2rad',
! sql => "SELECT GRAD2RAD(200)",
! result_near => pi,
! },
! {
! test => 'lotta radians',
! sql => "SELECT DEG2RAD(10000000000)",
! result_near => 4.88692191243172,
! },
! {
! test => 'negative degrees',
! sql => "SELECT RAD2DEG(-10000000000)",
! result_near => -330.8232421875,
! },
! {
! test => 'positive degrees',
! sql => "SELECT RAD2DEG(10000)",
! result_near => 197.795130823273,
! },
! {
! test => 'tanh 100',
! sql => "SELECT TANH(100)",
! result_near => 1,
! },
! {
! test => 'coth 100',
! sql => "SELECT COTH(100)",
! result_near => 1,
! },
! {
! test => 'tanh -100',
! sql => "SELECT TANH(-100)",
! result_near => -1,
! },
! {
! test => 'coth -100',
! sql => "SELECT COTH(-100)",
! result_near => -1,
! },
! {
! test => 'sech 1e5',
! sql => "SELECT SECH(100000)",
result => [ [0] ],
},
{
+ test => 'csch 1e5',
+ sql => "SELECT CSCH(100000)",
+ result => [ [0] ],
+ },
+ {
+ test => 'tanh 1e5',
+ sql => "SELECT TANH(100000)",
+ result => [ [1] ],
+ },
+ {
+ test => 'coth 1e5',
+ sql => "SELECT COTH(100000)",
+ result => [ [1] ],
+ },
+ {
+ test => 'sech -1e5',
+ sql => "SELECT SECH(-100000)",
+ result => [ [0] ],
+ },
+ {
+ test => 'csch -1e5',
+ sql => "SELECT CSCH(-100000)",
+ result => [ ['-0'] ],
+ comment=> 'Is meant to return a "negative zero"'
+ },
+ {
+ test => 'tanh -1e5',
+ sql => "SELECT TANH(-100000)",
+ result => [ [-1] ],
+ },
+ {
+ test => 'coth -1e5',
+ sql => "SELECT COTH(-100000)",
+ result => [ [-1] ],
+ },
+ ### System Functions
+ {
+ test => 'dbname',
+ sql => "SELECT DBNAME()",
+ result => [ [$dbh->{Name}] ],
+ },
+ {
+ test => 'username',
+ sql => "SELECT USERNAME()",
+ result => [ [$dbh->{CURRENT_USER}] ],
+ },
+ {
+ test => 'user',
+ sql => "SELECT USER()",
+ result => [ [$dbh->{CURRENT_USER}] ],
+ },
+ {
test => 'SELECT with calculation in WHERE CLAUSE',
sql =>
sprintf(
***************
*** 537,542 ****
--- 1380,1386 ----
{
test => 'Caclulation outside aggregation',
todo => "Known limitation. Parser/Engine can not handle properly",
+ passes => 'parse-DBD::CSV parse-DBD::File parse-DBD::DBM',
sql => "SELECT MAX(time_stamp) - 3*3600 FROM log",
result => [ [ $now - ( 3 * 3600 ) ] ],
},
***************
*** 565,575 ****
foreach my $test (@tests)
{
local $TODO;
! if( $test->{todo} )
! {
! note( "break here" );
! }
! defined( $test->{todo} ) and $TODO = $test->{todo};
if ( defined( $test->{prepare_err} ) )
{
$sth = $dbh->prepare( $test->{sql} );
--- 1409,1416 ----
foreach my $test (@tests)
{
local $TODO;
! defined($test->{todo}) and not (defined($test->{passes}) and $test->{passes} =~ /(?:parse|execute|result)(?:(?!-)|-\Q$test_dbd\E)/)
! and $TODO = $test->{todo};
if ( defined( $test->{prepare_err} ) )
{
$sth = $dbh->prepare( $test->{sql} );
***************
*** 580,585 ****
--- 1421,1429 ----
$sth = $dbh->prepare( $test->{sql} );
ok( $sth, "prepare $test->{sql} using $test_dbd" ) or diag( $dbh->errstr() );
$sth or next;
+
+ defined($test->{todo}) and not (defined($test->{passes}) and $test->{passes} =~ /(?:execute|result)(?:(?!-)|-\Q$test_dbd\E)/)
+ and $TODO = $test->{todo};
if ( defined( $test->{params} ) )
{
my $params;
***************
*** 627,632 ****
--- 1471,1478 ----
ok( $n, "execute $test->{sql} using $test_dbd" ) or diag( $dbh->errstr() );
'SELECT' eq $sth->command() or next;
+ defined($test->{todo}) and not (defined($test->{passes}) and $test->{passes} =~ /result(?:(?!-)|-\Q$test_dbd\E)/)
+ and $TODO = $test->{todo};
if ( $test->{result_cols} )
{
is_deeply( $sth->col_names(), $test->{result_cols}, "Columns in $test->{test}" );
***************
*** 641,646 ****
--- 1487,1502 ----
{
&{ $test->{result_code} }($sth);
}
+ elsif ( $test->{result_like} )
+ {
+ my $row = $sth->fetch_rows();
+ like( $row && $row->[0] && $row->[0][0], $test->{result_like}, $test->{test} );
+ }
+ elsif ( $test->{result_near} )
+ {
+ my $row = $sth->fetch_rows();
+ near( $row && $row->[0] && $row->[0][0], $test->{result_near}, $test->{test} );
+ }
else
{
is_deeply( $sth->fetch_rows(), $test->{result}, $test->{test} );
diff -rbc SQL-Statement-1.33/t/08join.t SQL-Statement-1.33_new/t/08join.t
*** SQL-Statement-1.33/t/08join.t 2010-12-27 11:16:20.000000000 -0500
--- SQL-Statement-1.33_new/t/08join.t 2011-12-15 18:06:19.000000000 -0500
***************
*** 408,413 ****
--- 408,414 ----
3 | c | |
},
todo => 'Analyze',
+ passes => 'columns',
},
{
test =>
***************
*** 424,429 ****
--- 425,431 ----
3 | c | |
},
todo => 'Analyze',
+ passes => 'columns',
},
{
test => "DEFAULT INNER (1) with named columns",
***************
*** 547,557 ****
{
$test->{test} or next;
local $TODO;
! if ( $test->{todo} )
! {
! note("break here");
! }
! defined( $test->{todo} ) and $TODO = $test->{todo};
if ( defined( $test->{prepare_err} ) )
{
$sth = $dbh->prepare( $test->{sql} );
--- 549,556 ----
{
$test->{test} or next;
local $TODO;
! defined($test->{todo}) and not (defined($test->{passes}) and $test->{passes} =~ /(?:parse|execute|columns|result)(?:(?!-)|-\Q$test_dbd\E)/)
! and $TODO = $test->{todo};
if ( defined( $test->{prepare_err} ) )
{
$sth = $dbh->prepare( $test->{sql} );
***************
*** 562,567 ****
--- 561,569 ----
$sth = $dbh->prepare( $test->{sql} );
ok( $sth, "prepare $test->{sql} using $test_dbd" ) or diag( $dbh->errstr() );
$sth or next;
+
+ defined($test->{todo}) and not (defined($test->{passes}) and $test->{passes} =~ /(?:execute|columns|result)(?:(?!-)|-\Q$test_dbd\E)/)
+ and $TODO = $test->{todo};
if ( defined( $test->{params} ) )
{
my $params;
***************
*** 609,619 ****
--- 611,625 ----
ok( $n, "execute $test->{sql} using $test_dbd" ) or diag( $dbh->errstr() );
'SELECT' eq $sth->command() or next;
+ defined($test->{todo}) and not (defined($test->{passes}) and $test->{passes} =~ /(?:columns|result)(?:(?!-)|-\Q$test_dbd\E)/)
+ and $TODO = $test->{todo};
if ( $test->{result_cols} )
{
is_deeply( $sth->col_names(), $test->{result_cols}, "Columns in $test->{test}" );
}
+ defined($test->{todo}) and not (defined($test->{passes}) and $test->{passes} =~ /result(?:(?!-)|-\Q$test_dbd\E)/)
+ and $TODO = $test->{todo};
if ( $test->{fetch_by} )
{
my $got_result = $sth->fetchall_hashref( $test->{fetch_by} );
diff -rbc SQL-Statement-1.33/xt/pod_coverage.t SQL-Statement-1.33_new/xt/pod_coverage.t
*** SQL-Statement-1.33/xt/pod_coverage.t 2010-09-10 08:43:23.000000000 -0400
--- SQL-Statement-1.33_new/xt/pod_coverage.t 2011-12-14 19:06:00.000000000 -0500
***************
*** 3,6 ****
use Test::More;
eval "use Test::Pod::Coverage 1.00";
plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD Coverage" if $@;
! all_pod_coverage_ok({ also_private => [ qr/^[A-Z_]+$/ ], trustme => [qr/^new$/] }); #Ignore all caps
--- 3,25 ----
use Test::More;
eval "use Test::Pod::Coverage 1.00";
plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD Coverage" if $@;
!
! my @modules = all_modules();
! plan tests => scalar @modules;
! foreach my $module (@modules) {
! next if ($module eq 'SQL::Statement::Functions');
! pod_coverage_ok($module, {also_private => [ qr/^[A-Z0-9_]+$/ ], trustme => [qr/^new$/]} ); # Ignore all caps/digits
! }
!
! # Warp the namespace a bit, so that Pod::Coverage can recognize the subs
! use SQL::Statement::Functions;
! my @keys = keys %SQL::Statement::Functions::;
! foreach my $subname (@keys) {
! my $short_name = $subname;
! $short_name =~ s/^SQL_FUNCTION_// || next;
! $SQL::Statement::Functions::{$short_name} = $SQL::Statement::Functions::{$subname};
! delete $SQL::Statement::Functions::{$subname};
! }
!
! ### FIXME: This seems to always return true... ###
! pod_coverage_ok( 'SQL::Statement::Functions', {private => [], also_private => [], trustme => []} );