[Bast-commits] r4926 - in SQL-Abstract/1.x/branches: . 1.50_RC
1.50_RC/lib 1.50_RC/lib/SQL 1.50_RC/t
dami at dev.catalyst.perl.org
dami at dev.catalyst.perl.org
Thu Oct 16 23:49:55 BST 2008
Author: dami
Date: 2008-10-16 23:49:55 +0100 (Thu, 16 Oct 2008)
New Revision: 4926
Added:
SQL-Abstract/1.x/branches/1.50_RC/
SQL-Abstract/1.x/branches/1.50_RC/Changes
SQL-Abstract/1.x/branches/1.50_RC/INSTALL
SQL-Abstract/1.x/branches/1.50_RC/MANIFEST
SQL-Abstract/1.x/branches/1.50_RC/MANIFEST.SKIP
SQL-Abstract/1.x/branches/1.50_RC/Makefile
SQL-Abstract/1.x/branches/1.50_RC/Makefile.PL
SQL-Abstract/1.x/branches/1.50_RC/lib/
SQL-Abstract/1.x/branches/1.50_RC/lib/SQL/
SQL-Abstract/1.x/branches/1.50_RC/lib/SQL/Abstract.pm
SQL-Abstract/1.x/branches/1.50_RC/t/
SQL-Abstract/1.x/branches/1.50_RC/t/00new.t
SQL-Abstract/1.x/branches/1.50_RC/t/01generate.t
SQL-Abstract/1.x/branches/1.50_RC/t/02where.t
SQL-Abstract/1.x/branches/1.50_RC/t/03values.t
SQL-Abstract/1.x/branches/1.50_RC/t/06order_by.t
SQL-Abstract/1.x/branches/1.50_RC/t/07subqueries.t
SQL-Abstract/1.x/branches/1.50_RC/t/08special_ops.t
SQL-Abstract/1.x/branches/1.50_RC/t/TestSqlAbstract.pm
Log:
Added: SQL-Abstract/1.x/branches/1.50_RC/Changes
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC/Changes (rev 0)
+++ SQL-Abstract/1.x/branches/1.50_RC/Changes 2008-10-16 22:49:55 UTC (rev 4926)
@@ -0,0 +1,95 @@
+Revision history for SQL::Abstract
+
+ - Make col => [] and col => {$op => [] } DTRT or die instead of generating
+ broken SQL. Added tests for this.
+ - Added { -desc => 'column' } order by support (Ash)
+ - Tiny "$_"-related fix for { -desc => 'columns'} order by support
+ - tests + docs (groditi)
+
+----------------------------
+revision 1.20
+date: 2005/08/18 18:41:58; author: nwiger; state: Exp; lines: +104 -50
+- added patch from Dan Kubb enabling quote_char and name_sep options
+- added patch from Andy Grundman to enhance _anoncopy for deep refs
+----------------------------
+revision 1.19
+date: 2005/04/29 18:20:30; author: nwiger; state: Exp; lines: +34 -20
+added _anoncopy to prevent destroying original; updated docs
+----------------------------
+revision 1.18
+date: 2005/03/07 20:14:12; author: nwiger; state: Exp; lines: +201 -65
+added support for -and, -or, and -nest; see docs for details
+----------------------------
+revision 1.17
+date: 2004/08/25 20:11:27; author: nwiger; state: Exp; lines: +58 -46
+added patch from Eric Kolve to iterate over all hashref elements
+----------------------------
+revision 1.16
+date: 2004/06/10 17:20:01; author: nwiger; state: Exp; lines: +178 -12
+added bindtype param to allow this to work with Orasuck 9+
+----------------------------
+revision 1.15
+date: 2003/11/05 23:40:40; author: nwiger; state: Exp; lines: +18 -6
+several bugfixes, including _convert being applied wrong and
+the edge case field => { '!=', [qw/this that/] } not working
+----------------------------
+revision 1.14
+date: 2003/11/04 21:20:33; author: nwiger; state: Exp; lines: +115 -34
+added patch from Philip Collins, and also added 'convert' option
+----------------------------
+revision 1.13
+date: 2003/05/21 17:22:29; author: nwiger; state: Exp; lines: +230 -74
+added "IN" and "BETWEEN" operator support, as well as "NOT"
+modified where() to support ORDER BY, and fixed some bugs too
+added PERFORMANCE and FORMBUILDER doc sections
+fixed several bugs in _recurse_where(), it now works as expected
+added test suite, many thanks to Chas Owens
+modified all hash access to return keys sorted, to allow cached queries
+----------------------------
+revision 1.12
+date: 2003/05/08 20:10:56; author: nwiger; state: Exp; lines: +181 -96
+1.11 interim checking; major bugfixes and order_by, 1.12 will go to CPAN
+----------------------------
+revision 1.11
+date: 2003/05/02 00:07:30; author: nwiger; state: Exp; lines: +52 -12
+many minor enhancements to add querying flexibility
+----------------------------
+revision 1.10
+date: 2002/09/27 18:06:25; author: nwiger; state: Exp; lines: +6 -2
+added precatch for messed up where string
+----------------------------
+revision 1.9
+date: 2002/08/29 18:04:35; author: nwiger; state: Exp; lines: +4 -3
+CPAN
+----------------------------
+revision 1.8
+date: 2001/11/07 22:18:12; author: nwiger; state: Exp; lines: +31 -14
+added embedded SCALAR ref capability to insert() and update()
+----------------------------
+revision 1.7
+date: 2001/11/07 01:23:28; author: nwiger; state: Exp; lines: +3 -3
+damn uninit warning
+----------------------------
+revision 1.6
+date: 2001/11/06 21:09:44; author: nwiger; state: Exp; lines: +14 -6
+oops, had to actually *implement* the order by for select()!
+----------------------------
+revision 1.5
+date: 2001/11/06 03:13:16; author: nwiger; state: Exp; lines: +43 -4
+lots of docs
+----------------------------
+revision 1.4
+date: 2001/11/06 03:07:42; author: nwiger; state: Exp; lines: +16 -7
+added extra layer of ()'s to ensure correct semantics on AND
+----------------------------
+revision 1.3
+date: 2001/11/06 01:16:31; author: nwiger; state: Exp; lines: +11 -10
+updated all statements so that they use wantarray to just return SQL if asked
+----------------------------
+revision 1.2
+date: 2001/10/26 22:23:46; author: nwiger; state: Exp; lines: +112 -15
+added scalar ref for SQL verbatim in where, fixed bugs, array ref, docs
+----------------------------
+revision 1.1
+date: 2001/10/24 00:26:43; author: nwiger; state: Exp;
+Initial revision
Added: SQL-Abstract/1.x/branches/1.50_RC/INSTALL
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC/INSTALL (rev 0)
+++ SQL-Abstract/1.x/branches/1.50_RC/INSTALL 2008-10-16 22:49:55 UTC (rev 4926)
@@ -0,0 +1,30 @@
+
+=head1 NAME
+
+INSTALL - how to install SQL::Abstract
+
+=head1 DESCRIPTION
+
+To install in your root Perl tree:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+If you want to relocate it elsewhere, say for testing, you need
+to change the C<MakeMaker PREFIX> variable:
+
+ perl Makefile.PL PREFIX=~/lib
+
+Note: This is true for CPAN modules and is not specific to C<SQL::Abstract>.
+
+=head1 AUTHOR
+
+Copyright (c) 2000-2006 Nate Wiger <nwiger at cpan.org>.
+All Rights Reserved.
+
+This module is free software; you may copy this under the terms of
+the GNU General Public License, or the Artistic License, copies of
+which should have accompanied your Perl kit.
+
Added: SQL-Abstract/1.x/branches/1.50_RC/MANIFEST
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC/MANIFEST (rev 0)
+++ SQL-Abstract/1.x/branches/1.50_RC/MANIFEST 2008-10-16 22:49:55 UTC (rev 4926)
@@ -0,0 +1,13 @@
+Changes
+INSTALL
+lib/SQL/Abstract.pm
+Makefile.PL
+MANIFEST This list of files
+t/00new.t
+t/01generate.t
+t/02where.t
+t/03values.t
+t/06order_by.t
+t/07subqueries.t
+t/08special_ops.t
+t/TestSqlAbstract.pm
Added: SQL-Abstract/1.x/branches/1.50_RC/MANIFEST.SKIP
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC/MANIFEST.SKIP (rev 0)
+++ SQL-Abstract/1.x/branches/1.50_RC/MANIFEST.SKIP 2008-10-16 22:49:55 UTC (rev 4926)
@@ -0,0 +1,44 @@
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+
+# Avoid Makemaker generated and utility files.
+\bMakefile$
+\bblib
+\bMakeMaker-\d
+\bpm_to_blib$
+\bblibdirs$
+^MANIFEST\.SKIP$
+
+# for developers only :)
+^TODO$
+^VERSIONING\.SKETCH$
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build
+
+# Avoid temp and backup files.
+~$
+\.tmp$
+\.old$
+\.bak$
+\#$
+\b\.#
+
+# avoid OS X finder files
+\.DS_Store$
+
+# Don't ship the test db
+^t/var
+
+# Don't ship the last dist we built :)
+\.tar\.gz$
+
+# Skip maint stuff
+^maint/
+
+# Avoid copies to .orig
+\.orig$
Added: SQL-Abstract/1.x/branches/1.50_RC/Makefile
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC/Makefile (rev 0)
+++ SQL-Abstract/1.x/branches/1.50_RC/Makefile 2008-10-16 22:49:55 UTC (rev 4926)
@@ -0,0 +1,810 @@
+# This Makefile is for the SQL::Abstract extension to perl.
+#
+# It was generated automatically by MakeMaker version
+# 6.44 (Revision: 54639) from the contents of
+# Makefile.PL. Don't edit this file, edit Makefile.PL instead.
+#
+# ANY CHANGES MADE HERE WILL BE LOST!
+#
+# MakeMaker ARGV: ()
+#
+# MakeMaker Parameters:
+
+# ABSTRACT_FROM => q[lib/SQL/Abstract.pm]
+# AUTHOR => q[Nathan Wiger (nate at wiger.org)]
+# NAME => q[SQL::Abstract]
+# PREREQ_PM => { List::Util=>q[0] }
+# VERSION_FROM => q[lib/SQL/Abstract.pm]
+
+# --- MakeMaker post_initialize section:
+
+
+# --- MakeMaker const_config section:
+
+# These definitions are from config.sh (via d:/Perl/lib/Config.pm).
+# They may have been overridden via Makefile.PL or on the command line.
+AR = ar
+CC = gcc
+CCCDLFLAGS =
+CCDLFLAGS =
+DLEXT = dll
+DLSRC = dl_win32.xs
+EXE_EXT = .exe
+FULL_AR =
+LD = g++
+LDDLFLAGS = -mdll -L"d:\perl\lib\CORE"
+LDFLAGS = -L"d:\perl\lib\CORE"
+LIBC = msvcrt.lib
+LIB_EXT = .a
+OBJ_EXT = .o
+OSNAME = MSWin32
+OSVERS = 5.00
+RANLIB = rem
+SITELIBEXP = d:\Perl\site\lib
+SITEARCHEXP = d:\Perl\site\lib
+SO = dll
+VENDORARCHEXP =
+VENDORLIBEXP =
+
+
+# --- MakeMaker constants section:
+AR_STATIC_ARGS = cr
+DIRFILESEP = ^\
+DFSEP = $(DIRFILESEP)
+NAME = SQL::Abstract
+NAME_SYM = SQL_Abstract
+VERSION = 1.49_01
+VERSION_MACRO = VERSION
+VERSION_SYM = 1_49_01
+DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\"
+XS_VERSION = 1.49_01
+XS_VERSION_MACRO = XS_VERSION
+XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\"
+INST_ARCHLIB = blib\arch
+INST_SCRIPT = blib\script
+INST_BIN = blib\bin
+INST_LIB = blib\lib
+INST_MAN1DIR = blib\man1
+INST_MAN3DIR = blib\man3
+MAN1EXT = 1
+MAN3EXT = 3
+INSTALLDIRS = site
+DESTDIR =
+PREFIX = $(SITEPREFIX)
+PERLPREFIX = d:\perl
+SITEPREFIX = d:\perl\site
+VENDORPREFIX =
+INSTALLPRIVLIB = d:\perl\lib
+DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB)
+INSTALLSITELIB = d:\perl\site\lib
+DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB)
+INSTALLVENDORLIB =
+DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB)
+INSTALLARCHLIB = d:\perl\lib
+DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB)
+INSTALLSITEARCH = d:\perl\site\lib
+DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH)
+INSTALLVENDORARCH =
+DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH)
+INSTALLBIN = d:\perl\bin
+DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN)
+INSTALLSITEBIN = d:\perl\site\bin
+DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN)
+INSTALLVENDORBIN =
+DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN)
+INSTALLSCRIPT = d:\perl\bin
+DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT)
+INSTALLSITESCRIPT = $(INSTALLSCRIPT)
+DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT)
+INSTALLVENDORSCRIPT =
+DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT)
+INSTALLMAN1DIR = d:\perl\man\man1
+DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR)
+INSTALLSITEMAN1DIR = $(INSTALLMAN1DIR)
+DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR)
+INSTALLVENDORMAN1DIR =
+DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR)
+INSTALLMAN3DIR = d:\perl\man\man3
+DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR)
+INSTALLSITEMAN3DIR = $(INSTALLMAN3DIR)
+DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR)
+INSTALLVENDORMAN3DIR =
+DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR)
+PERL_LIB = d:\Perl\lib
+PERL_ARCHLIB = d:\Perl\lib
+LIBPERL_A = libperl.a
+FIRST_MAKEFILE = Makefile
+MAKEFILE_OLD = Makefile.old
+MAKE_APERL_FILE = Makefile.aperl
+PERLMAINCC = $(CC)
+PERL_INC = D:\Perl\lib\CORE
+PERL = D:\Perl\bin\perl.exe
+FULLPERL = D:\Perl\bin\perl.exe
+ABSPERL = $(PERL)
+PERLRUN = $(PERL)
+FULLPERLRUN = $(FULLPERL)
+ABSPERLRUN = $(ABSPERL)
+PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
+FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
+ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
+PERL_CORE = 0
+PERM_RW = 644
+PERM_RWX = 755
+
+MAKEMAKER = d:/Perl/lib/ExtUtils/MakeMaker.pm
+MM_VERSION = 6.44
+MM_REVISION = 54639
+
+# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).
+# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)
+# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
+# DLBASE = Basename part of dynamic library. May be just equal BASEEXT.
+MAKE = nmake
+FULLEXT = SQL\Abstract
+BASEEXT = Abstract
+PARENT_NAME = SQL
+DLBASE = $(BASEEXT)
+VERSION_FROM = lib/SQL/Abstract.pm
+OBJECT =
+LDFROM = $(OBJECT)
+LINKTYPE = dynamic
+BOOTDEP =
+
+# Handy lists of source code files:
+XS_FILES =
+C_FILES =
+O_FILES =
+H_FILES =
+MAN1PODS =
+MAN3PODS = lib/SQL/Abstract.pm
+
+# Where is the Config information that we are using/depend on
+CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h
+
+# Where to build things
+INST_LIBDIR = $(INST_LIB)\SQL
+INST_ARCHLIBDIR = $(INST_ARCHLIB)\SQL
+
+INST_AUTODIR = $(INST_LIB)\auto\$(FULLEXT)
+INST_ARCHAUTODIR = $(INST_ARCHLIB)\auto\$(FULLEXT)
+
+INST_STATIC =
+INST_DYNAMIC =
+INST_BOOT =
+
+# Extra linker info
+EXPORT_LIST = $(BASEEXT).def
+PERL_ARCHIVE = $(PERL_INC)\perl58.lib
+PERL_ARCHIVE_AFTER =
+
+
+TO_INST_PM = lib/SQL/Abstract.pm
+
+PM_TO_BLIB = lib/SQL/Abstract.pm \
+ blib\lib\SQL\Abstract.pm
+
+
+# --- MakeMaker platform_constants section:
+MM_Win32_VERSION = 6.44
+
+
+# --- MakeMaker tool_autosplit section:
+# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
+AUTOSPLITFILE = $(ABSPERLRUN) -e "use AutoSplit; autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1)" --
+
+
+
+# --- MakeMaker tool_xsubpp section:
+
+
+# --- MakeMaker tools_other section:
+CHMOD = $(ABSPERLRUN) -MExtUtils::Command -e chmod
+CP = $(ABSPERLRUN) -MExtUtils::Command -e cp
+MV = $(ABSPERLRUN) -MExtUtils::Command -e mv
+NOOP = rem
+NOECHO = @
+RM_F = $(ABSPERLRUN) -MExtUtils::Command -e rm_f
+RM_RF = $(ABSPERLRUN) -MExtUtils::Command -e rm_rf
+TEST_F = $(ABSPERLRUN) -MExtUtils::Command -e test_f
+TOUCH = $(ABSPERLRUN) -MExtUtils::Command -e touch
+UMASK_NULL = umask 0
+DEV_NULL = > NUL
+MKPATH = $(ABSPERLRUN) "-MExtUtils::Command" -e mkpath
+EQUALIZE_TIMESTAMP = $(ABSPERLRUN) "-MExtUtils::Command" -e eqtime
+ECHO = $(ABSPERLRUN) -l -e "print qq{@ARGV}" --
+ECHO_N = $(ABSPERLRUN) -e "print qq{@ARGV}" --
+UNINST = 0
+VERBINST = 0
+MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e "install({@ARGV}, '$(VERBINST)', 0, '$(UNINST)');" --
+DOC_INSTALL = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e perllocal_install
+UNINSTALL = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e uninstall
+WARN_IF_OLD_PACKLIST = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e warn_if_old_packlist
+MACROSTART =
+MACROEND =
+USEMAKEFILE = -f
+FIXIN = pl2bat.bat
+
+
+# --- MakeMaker makemakerdflt section:
+makemakerdflt : all
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker dist section:
+TAR = tar
+TARFLAGS = cvf
+ZIP = zip
+ZIPFLAGS = -r
+COMPRESS = gzip --best
+SUFFIX = .gz
+SHAR = shar
+PREOP = $(NOECHO) $(NOOP)
+POSTOP = $(NOECHO) $(NOOP)
+TO_UNIX = $(NOECHO) $(NOOP)
+CI = ci -u
+RCS_LABEL = rcs -Nv$(VERSION_SYM): -q
+DIST_CP = best
+DIST_DEFAULT = tardist
+DISTNAME = SQL-Abstract
+DISTVNAME = SQL-Abstract-1.49_01
+
+
+# --- MakeMaker macro section:
+
+
+# --- MakeMaker depend section:
+
+
+# --- MakeMaker cflags section:
+
+
+# --- MakeMaker const_loadlibs section:
+
+
+# --- MakeMaker const_cccmd section:
+
+
+# --- MakeMaker post_constants section:
+
+
+# --- MakeMaker pasthru section:
+PASTHRU = -nologo
+
+# --- MakeMaker special_targets section:
+.SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT)
+
+.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir
+
+
+
+# --- MakeMaker c_o section:
+
+
+# --- MakeMaker xs_c section:
+
+
+# --- MakeMaker xs_o section:
+
+
+# --- MakeMaker top_targets section:
+all :: pure_all
+ $(NOECHO) $(NOOP)
+
+
+pure_all :: config pm_to_blib subdirs linkext
+ $(NOECHO) $(NOOP)
+
+subdirs :: $(MYEXTLIB)
+ $(NOECHO) $(NOOP)
+
+config :: $(FIRST_MAKEFILE) blibdirs
+ $(NOECHO) $(NOOP)
+
+help :
+ perldoc ExtUtils::MakeMaker
+
+
+# --- MakeMaker blibdirs section:
+blibdirs : $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists
+ $(NOECHO) $(NOOP)
+
+# Backwards compat with 6.18 through 6.25
+blibdirs.ts : blibdirs
+ $(NOECHO) $(NOOP)
+
+$(INST_LIBDIR)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_LIBDIR)
+ $(NOECHO) $(CHMOD) 755 $(INST_LIBDIR)
+ $(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists
+
+$(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_ARCHLIB)
+ $(NOECHO) $(CHMOD) 755 $(INST_ARCHLIB)
+ $(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists
+
+$(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_AUTODIR)
+ $(NOECHO) $(CHMOD) 755 $(INST_AUTODIR)
+ $(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists
+
+$(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
+ $(NOECHO) $(CHMOD) 755 $(INST_ARCHAUTODIR)
+ $(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists
+
+$(INST_BIN)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_BIN)
+ $(NOECHO) $(CHMOD) 755 $(INST_BIN)
+ $(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists
+
+$(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_SCRIPT)
+ $(NOECHO) $(CHMOD) 755 $(INST_SCRIPT)
+ $(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists
+
+$(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_MAN1DIR)
+ $(NOECHO) $(CHMOD) 755 $(INST_MAN1DIR)
+ $(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists
+
+$(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_MAN3DIR)
+ $(NOECHO) $(CHMOD) 755 $(INST_MAN3DIR)
+ $(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists
+
+
+
+# --- MakeMaker linkext section:
+
+linkext :: $(LINKTYPE)
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker dlsyms section:
+
+Abstract.def: Makefile.PL
+ $(PERLRUN) -MExtUtils::Mksymlists \
+ -e "Mksymlists('NAME'=>\"SQL::Abstract\", 'DLBASE' => '$(BASEEXT)', 'DL_FUNCS' => { }, 'FUNCLIST' => [], 'IMPORTS' => { }, 'DL_VARS' => []);"
+
+
+# --- MakeMaker dynamic section:
+
+dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT)
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker dynamic_bs section:
+
+BOOTSTRAP =
+
+
+# --- MakeMaker dynamic_lib section:
+
+
+# --- MakeMaker static section:
+
+## $(INST_PM) has been moved to the all: target.
+## It remains here for awhile to allow for old usage: "make static"
+static :: $(FIRST_MAKEFILE) $(INST_STATIC)
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker static_lib section:
+
+
+# --- MakeMaker manifypods section:
+
+POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--"
+POD2MAN = $(POD2MAN_EXE)
+
+
+manifypods : pure_all \
+ lib/SQL/Abstract.pm
+ $(NOECHO) $(POD2MAN) --section=3 --perm_rw=$(PERM_RW) \
+ lib/SQL/Abstract.pm $(INST_MAN3DIR)\SQL.Abstract.$(MAN3EXT)
+
+
+
+
+# --- MakeMaker processPL section:
+
+
+# --- MakeMaker installbin section:
+
+
+# --- MakeMaker subdirs section:
+
+# none
+
+# --- MakeMaker clean_subdirs section:
+clean_subdirs :
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker clean section:
+
+# Delete temporary files but do not touch installed files. We don't delete
+# the Makefile here so a later make realclean still has a makefile to use.
+
+clean :: clean_subdirs
+ - $(RM_F) \
+ *$(LIB_EXT) core \
+ core.[0-9] core.[0-9][0-9] \
+ $(BASEEXT).bso $(INST_ARCHAUTODIR)\extralibs.ld \
+ pm_to_blib.ts core.[0-9][0-9][0-9][0-9] \
+ $(BASEEXT).x $(BOOTSTRAP) \
+ perl$(EXE_EXT) tmon.out \
+ $(INST_ARCHAUTODIR)\extralibs.all *$(OBJ_EXT) \
+ pm_to_blib blibdirs.ts \
+ core.[0-9][0-9][0-9][0-9][0-9] *perl.core \
+ core.*perl.*.? $(MAKE_APERL_FILE) \
+ perl $(BASEEXT).def \
+ core.[0-9][0-9][0-9] mon.out \
+ lib$(BASEEXT).def perlmain.c \
+ perl.exe so_locations \
+ $(BASEEXT).exp
+ - $(RM_RF) \
+ dll.exp dll.base \
+ blib
+ - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL)
+
+
+# --- MakeMaker realclean_subdirs section:
+realclean_subdirs :
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker realclean section:
+# Delete temporary files (via clean) and also delete dist files
+realclean purge :: clean realclean_subdirs
+ - $(RM_F) \
+ $(MAKEFILE_OLD) $(FIRST_MAKEFILE)
+ - $(RM_RF) \
+ $(DISTVNAME)
+
+
+# --- MakeMaker metafile section:
+metafile : create_distdir
+ $(NOECHO) $(ECHO) Generating META.yml
+ $(NOECHO) $(ECHO) "--- #YAML:1.0" > META_new.yml
+ $(NOECHO) $(ECHO) "name: SQL-Abstract" >> META_new.yml
+ $(NOECHO) $(ECHO) "version: 1.49_01" >> META_new.yml
+ $(NOECHO) $(ECHO) "abstract: Generate SQL from Perl data structures" >> META_new.yml
+ $(NOECHO) $(ECHO) "license: ~" >> META_new.yml
+ $(NOECHO) $(ECHO) "author: " >> META_new.yml
+ $(NOECHO) $(ECHO) " - Nathan Wiger (nate at wiger.org)" >> META_new.yml
+ $(NOECHO) $(ECHO) "generated_by: ExtUtils::MakeMaker version 6.44" >> META_new.yml
+ $(NOECHO) $(ECHO) "distribution_type: module" >> META_new.yml
+ $(NOECHO) $(ECHO) "requires: " >> META_new.yml
+ $(NOECHO) $(ECHO) " List::Util: 0" >> META_new.yml
+ $(NOECHO) $(ECHO) "meta-spec:" >> META_new.yml
+ $(NOECHO) $(ECHO) " url: http://module-build.sourceforge.net/META-spec-v1.3.html" >> META_new.yml
+ $(NOECHO) $(ECHO) " version: 1.3" >> META_new.yml
+ -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml
+
+
+# --- MakeMaker signature section:
+signature :
+ cpansign -s
+
+
+# --- MakeMaker dist_basics section:
+distclean :: realclean distcheck
+ $(NOECHO) $(NOOP)
+
+distcheck :
+ $(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck
+
+skipcheck :
+ $(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck
+
+manifest :
+ $(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest
+
+veryclean : realclean
+ $(RM_F) *~ */*~ *.orig */*.orig *.bak */*.bak *.old */*.old
+
+
+
+# --- MakeMaker dist_core section:
+
+dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE)
+ $(NOECHO) $(ABSPERLRUN) -l -e "print 'Warning: Makefile possibly out of date with $(VERSION_FROM)'\
+ if -e '$(VERSION_FROM)' and -M '$(VERSION_FROM)' < -M '$(FIRST_MAKEFILE)';" --
+
+tardist : $(DISTVNAME).tar$(SUFFIX)
+ $(NOECHO) $(NOOP)
+
+uutardist : $(DISTVNAME).tar$(SUFFIX)
+ uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu
+
+$(DISTVNAME).tar$(SUFFIX) : distdir
+ $(PREOP)
+ $(TO_UNIX)
+ $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
+ $(RM_RF) $(DISTVNAME)
+ $(COMPRESS) $(DISTVNAME).tar
+ $(POSTOP)
+
+zipdist : $(DISTVNAME).zip
+ $(NOECHO) $(NOOP)
+
+$(DISTVNAME).zip : distdir
+ $(PREOP)
+ $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
+ $(RM_RF) $(DISTVNAME)
+ $(POSTOP)
+
+shdist : distdir
+ $(PREOP)
+ $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
+ $(RM_RF) $(DISTVNAME)
+ $(POSTOP)
+
+
+# --- MakeMaker distdir section:
+create_distdir :
+ $(RM_RF) $(DISTVNAME)
+ $(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \
+ -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
+
+distdir : create_distdir distmeta
+ $(NOECHO) $(NOOP)
+
+
+
+# --- MakeMaker dist_test section:
+disttest : distdir
+ cd $(DISTVNAME)
+ $(ABSPERLRUN) Makefile.PL
+ $(MAKE) $(PASTHRU)
+ $(MAKE) test $(PASTHRU)
+ cd ..
+
+
+
+# --- MakeMaker dist_ci section:
+
+ci :
+ $(PERLRUN) "-MExtUtils::Manifest=maniread" \
+ -e "@all = keys %{ maniread() };" \
+ -e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \
+ -e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});"
+
+
+# --- MakeMaker distmeta section:
+distmeta : create_distdir metafile
+ $(NOECHO) cd $(DISTVNAME)
+ $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e "eval { maniadd({q{META.yml} => q{Module meta-data (added by MakeMaker)}}) } \
+ or print \"Could not add META.yml to MANIFEST: $${'@'}\n\"" --
+ cd ..
+
+
+
+# --- MakeMaker distsignature section:
+distsignature : create_distdir
+ $(NOECHO) cd $(DISTVNAME)
+ $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e "eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } \
+ or print \"Could not add SIGNATURE to MANIFEST: $${'@'}\n\"" --
+ cd ..
+ $(NOECHO) cd $(DISTVNAME)
+ $(TOUCH) SIGNATURE
+ cd ..
+ cd $(DISTVNAME)
+ cpansign -s
+ cd ..
+
+
+
+# --- MakeMaker install section:
+
+install :: all pure_install doc_install
+ $(NOECHO) $(NOOP)
+
+install_perl :: all pure_perl_install doc_perl_install
+ $(NOECHO) $(NOOP)
+
+install_site :: all pure_site_install doc_site_install
+ $(NOECHO) $(NOOP)
+
+install_vendor :: all pure_vendor_install doc_vendor_install
+ $(NOECHO) $(NOOP)
+
+pure_install :: pure_$(INSTALLDIRS)_install
+ $(NOECHO) $(NOOP)
+
+doc_install :: doc_$(INSTALLDIRS)_install
+ $(NOECHO) $(NOOP)
+
+pure__install : pure_site_install
+ $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+doc__install : doc_site_install
+ $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+pure_perl_install ::
+ $(NOECHO) $(MOD_INSTALL) \
+ read $(PERL_ARCHLIB)\auto\$(FULLEXT)\.packlist \
+ write $(DESTINSTALLARCHLIB)\auto\$(FULLEXT)\.packlist \
+ $(INST_LIB) $(DESTINSTALLPRIVLIB) \
+ $(INST_ARCHLIB) $(DESTINSTALLARCHLIB) \
+ $(INST_BIN) $(DESTINSTALLBIN) \
+ $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \
+ $(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) \
+ $(INST_MAN3DIR) $(DESTINSTALLMAN3DIR)
+ $(NOECHO) $(WARN_IF_OLD_PACKLIST) \
+ $(SITEARCHEXP)\auto\$(FULLEXT)
+
+
+pure_site_install ::
+ $(NOECHO) $(MOD_INSTALL) \
+ read $(SITEARCHEXP)\auto\$(FULLEXT)\.packlist \
+ write $(DESTINSTALLSITEARCH)\auto\$(FULLEXT)\.packlist \
+ $(INST_LIB) $(DESTINSTALLSITELIB) \
+ $(INST_ARCHLIB) $(DESTINSTALLSITEARCH) \
+ $(INST_BIN) $(DESTINSTALLSITEBIN) \
+ $(INST_SCRIPT) $(DESTINSTALLSITESCRIPT) \
+ $(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) \
+ $(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR)
+ $(NOECHO) $(WARN_IF_OLD_PACKLIST) \
+ $(PERL_ARCHLIB)\auto\$(FULLEXT)
+
+pure_vendor_install ::
+ $(NOECHO) $(MOD_INSTALL) \
+ read $(VENDORARCHEXP)\auto\$(FULLEXT)\.packlist \
+ write $(DESTINSTALLVENDORARCH)\auto\$(FULLEXT)\.packlist \
+ $(INST_LIB) $(DESTINSTALLVENDORLIB) \
+ $(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \
+ $(INST_BIN) $(DESTINSTALLVENDORBIN) \
+ $(INST_SCRIPT) $(DESTINSTALLVENDORSCRIPT) \
+ $(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \
+ $(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR)
+
+doc_perl_install ::
+ $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod
+ -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
+ -$(NOECHO) $(DOC_INSTALL) \
+ "Module" "$(NAME)" \
+ "installed into" "$(INSTALLPRIVLIB)" \
+ LINKTYPE "$(LINKTYPE)" \
+ VERSION "$(VERSION)" \
+ EXE_FILES "$(EXE_FILES)" \
+ >> $(DESTINSTALLARCHLIB)\perllocal.pod
+
+doc_site_install ::
+ $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod
+ -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
+ -$(NOECHO) $(DOC_INSTALL) \
+ "Module" "$(NAME)" \
+ "installed into" "$(INSTALLSITELIB)" \
+ LINKTYPE "$(LINKTYPE)" \
+ VERSION "$(VERSION)" \
+ EXE_FILES "$(EXE_FILES)" \
+ >> $(DESTINSTALLARCHLIB)\perllocal.pod
+
+doc_vendor_install ::
+ $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod
+ -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
+ -$(NOECHO) $(DOC_INSTALL) \
+ "Module" "$(NAME)" \
+ "installed into" "$(INSTALLVENDORLIB)" \
+ LINKTYPE "$(LINKTYPE)" \
+ VERSION "$(VERSION)" \
+ EXE_FILES "$(EXE_FILES)" \
+ >> $(DESTINSTALLARCHLIB)\perllocal.pod
+
+
+uninstall :: uninstall_from_$(INSTALLDIRS)dirs
+ $(NOECHO) $(NOOP)
+
+uninstall_from_perldirs ::
+ $(NOECHO) $(UNINSTALL) $(PERL_ARCHLIB)\auto\$(FULLEXT)\.packlist
+
+uninstall_from_sitedirs ::
+ $(NOECHO) $(UNINSTALL) $(SITEARCHEXP)\auto\$(FULLEXT)\.packlist
+
+uninstall_from_vendordirs ::
+ $(NOECHO) $(UNINSTALL) $(VENDORARCHEXP)\auto\$(FULLEXT)\.packlist
+
+
+# --- MakeMaker force section:
+# Phony target to force checking subdirectories.
+FORCE :
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker perldepend section:
+
+
+# --- MakeMaker makefile section:
+# We take a very conservative approach here, but it's worth it.
+# We move Makefile to Makefile.old here to avoid gnu make looping.
+$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP)
+ $(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?"
+ $(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..."
+ -$(NOECHO) $(RM_F) $(MAKEFILE_OLD)
+ -$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD)
+ - $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL)
+ $(PERLRUN) Makefile.PL
+ $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <=="
+ $(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <=="
+ false
+
+
+
+# --- MakeMaker staticmake section:
+
+# --- MakeMaker makeaperl section ---
+MAP_TARGET = perl
+FULLPERL = D:\Perl\bin\perl.exe
+
+$(MAP_TARGET) :: static $(MAKE_APERL_FILE)
+ $(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@
+
+$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib
+ $(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
+ $(NOECHO) $(PERLRUNINST) \
+ Makefile.PL DIR= \
+ MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
+ MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=
+
+
+# --- MakeMaker test section:
+
+TEST_VERBOSE=0
+TEST_TYPE=test_$(LINKTYPE)
+TEST_FILE = test.pl
+TEST_FILES = t/*.t
+TESTDB_SW = -d
+
+testdb :: testdb_$(LINKTYPE)
+
+test :: $(TEST_TYPE) subdirs-test
+
+subdirs-test ::
+ $(NOECHO) $(NOOP)
+
+
+test_dynamic :: pure_all
+ $(FULLPERLRUN) "-MExtUtils::Command::MM" "-e" "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES)
+
+testdb_dynamic :: pure_all
+ $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE)
+
+test_ : test_dynamic
+
+test_static :: test_dynamic
+testdb_static :: testdb_dynamic
+
+
+# --- MakeMaker ppd section:
+# Creates a PPD (Perl Package Description) for a binary distribution.
+ppd :
+ $(NOECHO) $(ECHO) "<SOFTPKG NAME=\"$(DISTNAME)\" VERSION=\"1,49_01,0,0\">" > $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) " <TITLE>$(DISTNAME)</TITLE>" >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) " <ABSTRACT>Generate SQL from Perl data structures</ABSTRACT>" >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) " <AUTHOR>Nathan Wiger (nate at wiger.org)</AUTHOR>" >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) " <IMPLEMENTATION>" >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) " <DEPENDENCY NAME=\"List-Util\" VERSION=\"0,0,0,0\" />" >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) " <OS NAME=\"$(OSNAME)\" />" >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) " <ARCHITECTURE NAME=\"MSWin32-x86-multi-thread-5.8\" />" >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) " <CODEBASE HREF=\"\" />" >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) " </IMPLEMENTATION>" >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) "</SOFTPKG>" >> $(DISTNAME).ppd
+
+
+# --- MakeMaker pm_to_blib section:
+
+pm_to_blib : $(TO_INST_PM)
+ $(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e "pm_to_blib({@ARGV}, '$(INST_LIB)\auto', '$(PM_FILTER)')" -- \
+ lib/SQL/Abstract.pm blib\lib\SQL\Abstract.pm
+ $(NOECHO) $(TOUCH) pm_to_blib
+
+
+# --- MakeMaker selfdocument section:
+
+
+# --- MakeMaker postamble section:
+
+
+# End.
Added: SQL-Abstract/1.x/branches/1.50_RC/Makefile.PL
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC/Makefile.PL (rev 0)
+++ SQL-Abstract/1.x/branches/1.50_RC/Makefile.PL 2008-10-16 22:49:55 UTC (rev 4926)
@@ -0,0 +1,13 @@
+use 5.006;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ NAME => 'SQL::Abstract',
+ VERSION_FROM => 'lib/SQL/Abstract.pm', # finds $VERSION
+ PREREQ_PM => {
+ "List::Util" => 0
+ }, # e.g., Module::Name => 1.1
+ ABSTRACT_FROM => 'lib/SQL/Abstract.pm', # retrieve abstract from module
+ AUTHOR => 'Nathan Wiger (nate at wiger.org)',
+);
Added: SQL-Abstract/1.x/branches/1.50_RC/lib/SQL/Abstract.pm
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC/lib/SQL/Abstract.pm (rev 0)
+++ SQL-Abstract/1.x/branches/1.50_RC/lib/SQL/Abstract.pm 2008-10-16 22:49:55 UTC (rev 4926)
@@ -0,0 +1,2071 @@
+package SQL::Abstract; # see doc at end of file
+
+# LDNOTE : this code is heavy refactoring from original SQLA.
+# Several design decisions will need discussion during
+# the test / diffusion / acceptance phase; those are marked with flag
+# 'LDNOTE' (note by laurent.dami AT free.fr)
+
+use Carp;
+use strict;
+use warnings;
+use List::Util qw/first/;
+
+#======================================================================
+# GLOBALS
+#======================================================================
+
+our $VERSION = '1.49_01';
+
+our $AUTOLOAD;
+
+# special operators (-in, -between). May be extended/overridden by user.
+# See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
+my @BUILTIN_SPECIAL_OPS = (
+ {regex => qr/^(not )?between$/i, handler => \&_where_field_BETWEEN},
+ {regex => qr/^(not )?in$/i, handler => \&_where_field_IN},
+);
+
+#======================================================================
+# DEBUGGING AND ERROR REPORTING
+#======================================================================
+
+sub _debug {
+ return unless $_[0]->{debug}; shift; # a little faster
+ my $func = (caller(1))[3];
+ warn "[$func] ", @_, "\n";
+}
+
+sub belch (@) {
+ my($func) = (caller(1))[3];
+ carp "[$func] Warning: ", @_;
+}
+
+sub puke (@) {
+ my($func) = (caller(1))[3];
+ croak "[$func] Fatal: ", @_;
+}
+
+
+#======================================================================
+# NEW
+#======================================================================
+
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
+
+ # choose our case by keeping an option around
+ delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
+
+ # default logic for interpreting arrayrefs
+ $opt{logic} = uc $opt{logic} || 'OR';
+
+ # how to return bind vars
+ # LDNOTE: changed nwiger code : why this 'delete' ??
+ # $opt{bindtype} ||= delete($opt{bind_type}) || 'normal';
+ $opt{bindtype} ||= 'normal';
+
+ # default comparison is "=", but can be overridden
+ $opt{cmp} ||= '=';
+
+ # try to recognize which are the 'equality' and 'unequality' ops
+ # (temporary quickfix, should go through a more seasoned API)
+ $opt{equality_op} = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i;
+ $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i;
+
+ # SQL booleans
+ $opt{sqltrue} ||= '1=1';
+ $opt{sqlfalse} ||= '0=1';
+
+ # special operators
+ $opt{special_ops} ||= [];
+ push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
+
+ return bless \%opt, $class;
+}
+
+
+
+#======================================================================
+# INSERT methods
+#======================================================================
+
+sub insert {
+ my $self = shift;
+ my $table = $self->_table(shift);
+ my $data = shift || return;
+
+ my $method = $self->_METHOD_FOR_refkind("_insert", $data);
+ my ($sql, @bind) = $self->$method($data);
+ $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
+ return wantarray ? ($sql, @bind) : $sql;
+}
+
+sub _insert_HASHREF { # explicit list of fields and then values
+ my ($self, $data) = @_;
+
+ my @fields = sort keys %$data;
+
+ my ($sql, @bind);
+ { # get values (need temporary override of bindtype to avoid an error)
+ local $self->{bindtype} = 'normal';
+ ($sql, @bind) = $self->_insert_ARRAYREF([@{$data}{@fields}]);
+ }
+
+ # if necessary, transform values according to 'bindtype'
+ if ($self->{bindtype} eq 'columns') {
+ for my $i (0 .. $#fields) {
+ ($bind[$i]) = $self->_bindtype($fields[$i], $bind[$i]);
+ }
+ }
+
+ # assemble SQL
+ $_ = $self->_quote($_) foreach @fields;
+ $sql = "( ".join(", ", @fields).") ".$sql;
+
+ return ($sql, @bind);
+}
+
+sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
+ my ($self, $data) = @_;
+
+ # no names (arrayref) so can't generate bindtype
+ $self->{bindtype} ne 'columns'
+ or belch "can't do 'columns' bindtype when called with arrayref";
+
+ my (@values, @all_bind);
+ for my $v (@$data) {
+
+ $self->_SWITCH_refkind($v, {
+
+ ARRAYREF => sub {
+ if ($self->{array_datatypes}) { # if array datatype are activated
+ push @values, '?';
+ }
+ else { # else literal SQL with bind
+ my ($sql, @bind) = @$v;
+ push @values, $sql;
+ push @all_bind, @bind;
+ }
+ },
+
+ ARRAYREFREF => sub { # literal SQL with bind
+ my ($sql, @bind) = @${$v};
+ push @values, $sql;
+ push @all_bind, @bind;
+ },
+
+ # THINK : anything useful to do with a HASHREF ?
+
+ SCALARREF => sub { # literal SQL without bind
+ push @values, $$v;
+ },
+
+ SCALAR_or_UNDEF => sub {
+ push @values, '?';
+ push @all_bind, $v;
+ },
+
+ });
+
+ }
+
+ my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
+ return ($sql, @all_bind);
+}
+
+
+sub _insert_ARRAYREFREF { # literal SQL with bind
+ my ($self, $data) = @_;
+ return @${$data};
+}
+
+
+sub _insert_SCALARREF { # literal SQL without bind
+ my ($self, $data) = @_;
+
+ return ($$data);
+}
+
+
+
+#======================================================================
+# UPDATE methods
+#======================================================================
+
+
+sub update {
+ my $self = shift;
+ my $table = $self->_table(shift);
+ my $data = shift || return;
+ my $where = shift;
+
+ # first build the 'SET' part of the sql statement
+ my (@set, @all_bind);
+ puke "Unsupported data type specified to \$sql->update"
+ unless ref $data eq 'HASH';
+
+ for my $k (sort keys %$data) {
+ my $v = $data->{$k};
+ my $r = ref $v;
+ my $label = $self->_quote($k);
+
+ $self->_SWITCH_refkind($v, {
+ ARRAYREF => sub {
+ if ($self->{array_datatypes}) { # array datatype
+ push @set, "$label = ?";
+ push @all_bind, $self->_bindtype($k, $v);
+ }
+ else { # literal SQL with bind
+ my ($sql, @bind) = @$v;
+ push @set, "$label = $sql";
+ push @all_bind, $self->_bindtype($k, @bind);
+ }
+ },
+ ARRAYREFREF => sub { # literal SQL with bind
+ my ($sql, @bind) = @${$v};
+ push @set, "$label = $sql";
+ push @all_bind, $self->_bindtype($k, @bind);
+ },
+ SCALARREF => sub { # literal SQL without bind
+ push @set, "$label = $$v";
+ },
+ SCALAR_or_UNDEF => sub {
+ push @set, "$label = ?";
+ push @all_bind, $self->_bindtype($k, $v);
+ },
+ });
+ }
+
+ # generate sql
+ my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ')
+ . join ', ', @set;
+
+ if ($where) {
+ my($where_sql, @where_bind) = $self->where($where);
+ $sql .= $where_sql;
+ push @all_bind, @where_bind;
+ }
+
+ return wantarray ? ($sql, @all_bind) : $sql;
+}
+
+
+
+
+#======================================================================
+# SELECT
+#======================================================================
+
+
+sub select {
+ my $self = shift;
+ my $table = $self->_table(shift);
+ my $fields = shift || '*';
+ my $where = shift;
+ my $order = shift;
+
+ my($where_sql, @bind) = $self->where($where, $order);
+
+ my $f = (ref $fields eq 'ARRAY') ? join ', ', map { $self->_quote($_) } @$fields
+ : $fields;
+ my $sql = join(' ', $self->_sqlcase('select'), $f,
+ $self->_sqlcase('from'), $table)
+ . $where_sql;
+
+ return wantarray ? ($sql, @bind) : $sql;
+}
+
+#======================================================================
+# DELETE
+#======================================================================
+
+
+sub delete {
+ my $self = shift;
+ my $table = $self->_table(shift);
+ my $where = shift;
+
+
+ my($where_sql, @bind) = $self->where($where);
+ my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
+
+ return wantarray ? ($sql, @bind) : $sql;
+}
+
+
+#======================================================================
+# WHERE: entry point
+#======================================================================
+
+
+
+# Finally, a separate routine just to handle WHERE clauses
+sub where {
+ my ($self, $where, $order) = @_;
+
+ # where ?
+ my ($sql, @bind) = $self->_recurse_where($where);
+ $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
+
+ # order by?
+ if ($order) {
+ $sql .= $self->_order_by($order);
+ }
+
+ return wantarray ? ($sql, @bind) : $sql;
+}
+
+
+sub _recurse_where {
+ my ($self, $where, $logic) = @_;
+
+ # dispatch on appropriate method according to refkind of $where
+ my $method = $self->_METHOD_FOR_refkind("_where", $where);
+ $self->$method($where, $logic);
+}
+
+
+
+#======================================================================
+# WHERE: top-level ARRAYREF
+#======================================================================
+
+
+sub _where_ARRAYREF {
+ my ($self, $where, $logic) = @_;
+
+ $logic = uc($logic || $self->{logic});
+ $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
+
+ my @clauses = @$where;
+
+ # if the array starts with [-and|or => ...], recurse with that logic
+ my $first = $clauses[0] || '';
+ if ($first =~ /^-(and|or)/i) {
+ $logic = $1;
+ shift @clauses;
+ return $self->_where_ARRAYREF(\@clauses, $logic);
+ }
+
+ #otherwise..
+ my (@sql_clauses, @all_bind);
+
+ # need to use while() so can shift() for pairs
+ while (my $el = shift @clauses) {
+
+ # switch according to kind of $el and get corresponding ($sql, @bind)
+ my ($sql, @bind) = $self->_SWITCH_refkind($el, {
+
+ # skip empty elements, otherwise get invalid trailing AND stuff
+ ARRAYREF => sub {$self->_recurse_where($el) if @$el},
+
+ HASHREF => sub {$self->_recurse_where($el, 'and') if %$el},
+ # LDNOTE : previous SQLA code for hashrefs was creating a dirty
+ # side-effect: the first hashref within an array would change
+ # the global logic to 'AND'. So [ {cond1, cond2}, [cond3, cond4] ]
+ # was interpreted as "(cond1 AND cond2) OR (cond3 AND cond4)",
+ # whereas it should be "(cond1 AND cond2) OR (cond3 OR cond4)".
+
+ SCALARREF => sub { ($$el); },
+
+ SCALAR => sub {# top-level arrayref with scalars, recurse in pairs
+ $self->_recurse_where({$el => shift(@clauses)})},
+
+ UNDEF => sub {puke "not supported : UNDEF in arrayref" },
+ });
+
+ push @sql_clauses, $sql;
+ push @all_bind, @bind;
+ }
+
+ return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
+}
+
+
+
+#======================================================================
+# WHERE: top-level HASHREF
+#======================================================================
+
+sub _where_HASHREF {
+ my ($self, $where) = @_;
+ my (@sql_clauses, @all_bind);
+
+ # LDNOTE : don't really know why we need to sort keys
+ for my $k (sort keys %$where) {
+ my $v = $where->{$k};
+
+ # ($k => $v) is either a special op or a regular hashpair
+ my ($sql, @bind) = ($k =~ /^-(.+)/) ? $self->_where_op_in_hash($1, $v)
+ : do {
+ my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
+ $self->$method($k, $v);
+ };
+
+ push @sql_clauses, $sql;
+ push @all_bind, @bind;
+ }
+
+ return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
+}
+
+
+sub _where_op_in_hash {
+ my ($self, $op, $v) = @_;
+
+ $op =~ /^(AND|OR|NEST)[_\d]*/i
+ or puke "unknown operator: -$op";
+ $op = uc($1); # uppercase, remove trailing digits
+ $self->_debug("OP(-$op) within hashref, recursing...");
+
+ $self->_SWITCH_refkind($v, {
+
+ ARRAYREF => sub {
+ # LDNOTE : should deprecate {-or => [...]} and {-and => [...]}
+ # because they are misleading; the only proper way would be
+ # -nest => [-or => ...], -nest => [-and ...]
+ return $self->_where_ARRAYREF($v, $op eq 'NEST' ? '' : $op);
+ },
+
+ HASHREF => sub {
+ if ($op eq 'OR') {
+ belch "-or => {...} should be -nest => [...]";
+ return $self->_where_ARRAYREF([%$v], 'OR');
+ }
+ else { # NEST | AND
+ return $self->_where_HASHREF($v);
+ }
+ },
+
+ SCALARREF => sub { # literal SQL
+ $op eq 'NEST'
+ or puke "-$op => \\\$scalar not supported, use -nest => ...";
+ return ($$v);
+ },
+
+ ARRAYREFREF => sub { # literal SQL
+ $op eq 'NEST'
+ or puke "-$op => \\[..] not supported, use -nest => ...";
+ return @{${$v}};
+ },
+
+ SCALAR => sub { # permissively interpreted as SQL
+ $op eq 'NEST'
+ or puke "-$op => 'scalar' not supported, use -nest => \\'scalar'";
+ belch "literal SQL should be -nest => \\'scalar' "
+ . "instead of -nest => 'scalar' ";
+ return ($v);
+ },
+
+ UNDEF => sub {
+ puke "-$op => undef not supported";
+ },
+ });
+}
+
+
+sub _where_hashpair_ARRAYREF {
+ my ($self, $k, $v) = @_;
+
+ if( @$v ) {
+ my @v = @$v; # need copy because of shift below
+ $self->_debug("ARRAY($k) means distribute over elements");
+
+ # put apart first element if it is an operator (-and, -or)
+ my $op = $v[0] =~ /^-/ ? shift @v : undef;
+ $self->_debug("OP($op) reinjected into the distributed array") if $op;
+
+ my @distributed = map { {$k => $_} } @v;
+ unshift @distributed, $op if $op;
+
+ return $self->_recurse_where(\@distributed);
+ }
+ else {
+ # LDNOTE : not sure of this one. What does "distribute over nothing" mean?
+ $self->_debug("empty ARRAY($k) means 0=1");
+ return ($self->{sqlfalse});
+ }
+}
+
+sub _where_hashpair_HASHREF {
+ my ($self, $k, $v) = @_;
+
+ my (@all_sql, @all_bind);
+
+ for my $op (sort keys %$v) {
+ my $val = $v->{$op};
+
+ # put the operator in canonical form
+ $op =~ s/^-//; # remove initial dash
+ $op =~ tr/_/ /; # underscores become spaces
+ $op =~ s/^\s+//; # no initial space
+ $op =~ s/\s+$//; # no final space
+ $op =~ s/\s+/ /; # multiple spaces become one
+
+ my ($sql, @bind);
+
+ # CASE: special operators like -in or -between
+ my $special_op = first {$op =~ $_->{regex}} @{$self->{special_ops}};
+ if ($special_op) {
+ ($sql, @bind) = $special_op->{handler}->($self, $k, $op, $val);
+ }
+
+ # CASE: col => {op => \@vals}
+ elsif (ref $val eq 'ARRAY') {
+ ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
+ }
+
+ # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
+ elsif (! defined($val)) {
+ my $is = ($op =~ $self->{equality_op}) ? 'is' :
+ ($op =~ $self->{inequality_op}) ? 'is not' :
+ puke "unexpected operator '$op' with undef operand";
+ $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
+ }
+
+ # CASE: col => {op => $scalar}
+ else {
+ $sql = join ' ', $self->_convert($self->_quote($k)),
+ $self->_sqlcase($op),
+ $self->_convert('?');
+ @bind = $self->_bindtype($k, $val);
+ }
+
+ push @all_sql, $sql;
+ push @all_bind, @bind;
+ }
+
+ return $self->_join_sql_clauses('and', \@all_sql, \@all_bind);
+}
+
+
+
+sub _where_field_op_ARRAYREF {
+ my ($self, $k, $op, $vals) = @_;
+
+ if(@$vals) {
+ $self->_debug("ARRAY($vals) means multiple elements: [ @$vals ]");
+
+
+
+ # LDNOTE : change the distribution logic when
+ # $op =~ $self->{inequality_op}, because of Morgan laws :
+ # with {field => {'!=' => [22, 33]}}, it would be ridiculous to generate
+ # WHERE field != 22 OR field != 33 : the user probably means
+ # WHERE field != 22 AND field != 33.
+ my $logic = ($op =~ $self->{inequality_op}) ? 'AND' : 'OR';
+
+ # distribute $op over each member of @$vals
+ return $self->_recurse_where([map { {$k => {$op, $_}} } @$vals], $logic);
+
+ }
+ else {
+ # try to DWIM on equality operators
+ # LDNOTE : not 100% sure this is the correct thing to do ...
+ return ($self->{sqlfalse}) if $op =~ $self->{equality_op};
+ return ($self->{sqltrue}) if $op =~ $self->{inequality_op};
+
+ # otherwise
+ puke "operator '$op' applied on an empty array (field '$k')";
+ }
+}
+
+
+sub _where_hashpair_SCALARREF {
+ my ($self, $k, $v) = @_;
+ $self->_debug("SCALAR($k) means literal SQL: $$v");
+ my $sql = $self->_quote($k) . " " . $$v;
+ return ($sql);
+}
+
+sub _where_hashpair_ARRAYREFREF {
+ my ($self, $k, $v) = @_;
+ $self->_debug("REF($k) means literal SQL: @${$v}");
+ my ($sql, @bind) = @${$v};
+ $sql = $self->_quote($k) . " " . $sql;
+ @bind = $self->_bindtype($k, @bind);
+ return ($sql, @bind );
+}
+
+sub _where_hashpair_SCALAR {
+ my ($self, $k, $v) = @_;
+ $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
+ my $sql = join ' ', $self->_convert($self->_quote($k)),
+ $self->_sqlcase($self->{cmp}),
+ $self->_convert('?');
+ my @bind = $self->_bindtype($k, $v);
+ return ( $sql, @bind);
+}
+
+
+sub _where_hashpair_UNDEF {
+ my ($self, $k, $v) = @_;
+ $self->_debug("UNDEF($k) means IS NULL");
+ my $sql = $self->_quote($k) . $self->_sqlcase(' is null');
+ return ($sql);
+}
+
+#======================================================================
+# WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
+#======================================================================
+
+
+sub _where_SCALARREF {
+ my ($self, $where) = @_;
+
+ # literal sql
+ $self->_debug("SCALAR(*top) means literal SQL: $$where");
+ return ($$where);
+}
+
+
+sub _where_SCALAR {
+ my ($self, $where) = @_;
+
+ # literal sql
+ $self->_debug("NOREF(*top) means literal SQL: $where");
+ return ($where);
+}
+
+
+sub _where_UNDEF {
+ my ($self) = @_;
+ return ();
+}
+
+
+#======================================================================
+# WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
+#======================================================================
+
+
+sub _where_field_BETWEEN {
+ my ($self, $k, $op, $vals) = @_;
+
+ ref $vals eq 'ARRAY' && @$vals == 2
+ or puke "special op 'between' requires an arrayref of two values";
+
+ my ($label) = $self->_convert($self->_quote($k));
+ my ($placeholder) = $self->_convert('?');
+ my $and = $self->_sqlcase('and');
+ $op = $self->_sqlcase($op);
+
+ my $sql = "( $label $op $placeholder $and $placeholder )";
+ my @bind = $self->_bindtype($k, @$vals);
+ return ($sql, @bind)
+}
+
+
+sub _where_field_IN {
+ my ($self, $k, $op, $vals) = @_;
+
+ # backwards compatibility : if scalar, force into an arrayref
+ $vals = [$vals] if defined $vals && ! ref $vals;
+
+ ref $vals eq 'ARRAY'
+ or puke "special op 'in' requires an arrayref";
+
+ my ($label) = $self->_convert($self->_quote($k));
+ my ($placeholder) = $self->_convert('?');
+ my $and = $self->_sqlcase('and');
+ $op = $self->_sqlcase($op);
+
+ if (@$vals) { # nonempty list
+ my $placeholders = join ", ", (($placeholder) x @$vals);
+ my $sql = "$label $op ( $placeholders )";
+ my @bind = $self->_bindtype($k, @$vals);
+
+ return ($sql, @bind);
+ }
+ else { # empty list : some databases won't understand "IN ()", so DWIM
+ my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
+ return ($sql);
+ }
+}
+
+
+
+
+
+
+#======================================================================
+# ORDER BY
+#======================================================================
+
+sub _order_by {
+ my ($self, $arg) = @_;
+
+ # construct list of ordering instructions
+ my @order = $self->_SWITCH_refkind($arg, {
+
+ ARRAYREF => sub {
+ map {$self->_SWITCH_refkind($_, {
+ SCALAR => sub {$self->_quote($_)},
+ SCALARREF => sub {$$_}, # literal SQL, no quoting
+ HASHREF => sub {$self->_order_by_hash($_)}
+ }) } @$arg;
+ },
+
+ SCALAR => sub {$self->_quote($arg)},
+ SCALARREF => sub {$$arg}, # literal SQL, no quoting
+ HASHREF => sub {$self->_order_by_hash($arg)},
+
+ });
+
+ # build SQL
+ my $order = join ', ', @order;
+ return $order ? $self->_sqlcase(' order by')." $order" : '';
+}
+
+
+sub _order_by_hash {
+ my ($self, $hash) = @_;
+
+ # get first pair in hash
+ my ($key, $val) = each %$hash;
+
+ # check if one pair was found and no other pair in hash
+ $key && !(each %$hash)
+ or puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
+
+ my ($order) = ($key =~ /^-(desc|asc)/i)
+ or puke "invalid key in _order_by hash : $key";
+
+ return $self->_quote($val) ." ". $self->_sqlcase($order);
+}
+
+
+
+#======================================================================
+# DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
+#======================================================================
+
+sub _table {
+ my $self = shift;
+ my $from = shift;
+ $self->_SWITCH_refkind($from, {
+ ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;},
+ SCALAR => sub {$self->_quote($from)},
+ SCALARREF => sub {$$from},
+ ARRAYREFREF => sub {join ', ', @$from;},
+ });
+}
+
+
+#======================================================================
+# UTILITY FUNCTIONS
+#======================================================================
+
+sub _quote {
+ my $self = shift;
+ my $label = shift;
+
+ $label or puke "can't quote an empty label";
+
+ # left and right quote characters
+ my ($ql, $qr, @other) = $self->_SWITCH_refkind($self->{quote_char}, {
+ SCALAR => sub {($self->{quote_char}, $self->{quote_char})},
+ ARRAYREF => sub {@{$self->{quote_char}}},
+ UNDEF => sub {()},
+ });
+ not @other
+ or puke "quote_char must be an arrayref of 2 values";
+
+ # no quoting if no quoting chars
+ $ql or return $label;
+
+ # no quoting for literal SQL
+ return $$label if ref($label) eq 'SCALAR';
+
+ # separate table / column (if applicable)
+ my $sep = $self->{name_sep} || '';
+ my @to_quote = $sep ? split /\Q$sep\E/, $label : ($label);
+
+ # do the quoting, except for "*" or for `table`.*
+ my @quoted = map { $_ eq '*' ? $_: $ql.$_.$qr} @to_quote;
+
+ # reassemble and return.
+ return join $sep, @quoted;
+}
+
+
+# Conversion, if applicable
+sub _convert ($) {
+ my ($self, $arg) = @_;
+
+# LDNOTE : modified the previous implementation below because
+# it was not consistent : the first "return" is always an array,
+# the second "return" is context-dependent. Anyway, _convert
+# seems always used with just a single argument, so make it a
+# scalar function.
+# return @_ unless $self->{convert};
+# my $conv = $self->_sqlcase($self->{convert});
+# my @ret = map { $conv.'('.$_.')' } @_;
+# return wantarray ? @ret : $ret[0];
+ if ($self->{convert}) {
+ my $conv = $self->_sqlcase($self->{convert});
+ $arg = $conv.'('.$arg.')';
+ }
+ return $arg;
+}
+
+# And bindtype
+sub _bindtype (@) {
+ my $self = shift;
+ my($col, @vals) = @_;
+
+ #LDNOTE : changed original implementation below because it did not make
+ # sense when bindtype eq 'columns' and @vals > 1.
+# return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
+
+ return $self->{bindtype} eq 'columns' ? map {[$col, $_]} @vals : @vals;
+}
+
+sub _join_sql_clauses {
+ my ($self, $logic, $clauses_aref, $bind_aref) = @_;
+
+ if (@$clauses_aref > 1) {
+ my $join = " " . $self->_sqlcase($logic) . " ";
+ my $sql = '( ' . join($join, @$clauses_aref) . ' )';
+ return ($sql, @$bind_aref);
+ }
+ elsif (@$clauses_aref) {
+ return ($clauses_aref->[0], @$bind_aref); # no parentheses
+ }
+ else {
+ return (); # if no SQL, ignore @$bind_aref
+ }
+}
+
+
+# Fix SQL case, if so requested
+sub _sqlcase {
+ my $self = shift;
+
+ # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
+ # don't touch the argument ... crooked logic, but let's not change it!
+ return $self->{case} ? $_[0] : uc($_[0]);
+}
+
+
+#======================================================================
+# DISPATCHING FROM REFKIND
+#======================================================================
+
+sub _refkind {
+ my ($self, $data) = @_;
+ my $suffix = '';
+ my $ref;
+
+ # $suffix = 'REF' x (length of ref chain, i. e. \\[] is REFREFREF)
+ while (1) {
+ $suffix .= 'REF';
+ $ref = ref $data;
+ last if $ref ne 'REF';
+ $data = $$data;
+ }
+
+ return $ref ? $ref.$suffix :
+ defined $data ? 'SCALAR' :
+ 'UNDEF';
+}
+
+sub _try_refkind {
+ my ($self, $data) = @_;
+ my @try = ($self->_refkind($data));
+ push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
+ push @try, 'FALLBACK';
+ return @try;
+}
+
+sub _METHOD_FOR_refkind {
+ my ($self, $meth_prefix, $data) = @_;
+ my $method = first {$_} map {$self->can($meth_prefix."_".$_)}
+ $self->_try_refkind($data)
+ or puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
+ return $method;
+}
+
+
+sub _SWITCH_refkind {
+ my ($self, $data, $dispatch_table) = @_;
+
+ my $coderef = first {$_} map {$dispatch_table->{$_}}
+ $self->_try_refkind($data)
+ or puke "no dispatch entry for ".$self->_refkind($data);
+ $coderef->();
+}
+
+
+
+
+#======================================================================
+# VALUES, GENERATE, AUTOLOAD
+#======================================================================
+
+# LDNOTE: original code from nwiger, didn't touch code in that section
+# I feel the AUTOLOAD stuff should not be the default, it should
+# only be activated on explicit demand by user.
+
+sub values {
+ my $self = shift;
+ my $data = shift || return;
+ puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
+ unless ref $data eq 'HASH';
+ return map { $self->_bindtype($_, $data->{$_}) } sort keys %$data;
+}
+
+sub generate {
+ my $self = shift;
+
+ my(@sql, @sqlq, @sqlv);
+
+ for (@_) {
+ my $ref = ref $_;
+ if ($ref eq 'HASH') {
+ for my $k (sort keys %$_) {
+ my $v = $_->{$k};
+ my $r = ref $v;
+ my $label = $self->_quote($k);
+ if ($r eq 'ARRAY') {
+ # SQL included for values
+ my @bind = @$v;
+ my $sql = shift @bind;
+ push @sqlq, "$label = $sql";
+ push @sqlv, $self->_bindtype($k, @bind);
+ } elsif ($r eq 'SCALAR') {
+ # embedded literal SQL
+ push @sqlq, "$label = $$v";
+ } else {
+ push @sqlq, "$label = ?";
+ push @sqlv, $self->_bindtype($k, $v);
+ }
+ }
+ push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
+ } elsif ($ref eq 'ARRAY') {
+ # unlike insert(), assume these are ONLY the column names, i.e. for SQL
+ for my $v (@$_) {
+ my $r = ref $v;
+ if ($r eq 'ARRAY') {
+ my @val = @$v;
+ push @sqlq, shift @val;
+ push @sqlv, @val;
+ } elsif ($r eq 'SCALAR') {
+ # embedded literal SQL
+ push @sqlq, $$v;
+ } else {
+ push @sqlq, '?';
+ push @sqlv, $v;
+ }
+ }
+ push @sql, '(' . join(', ', @sqlq) . ')';
+ } elsif ($ref eq 'SCALAR') {
+ # literal SQL
+ push @sql, $$_;
+ } else {
+ # strings get case twiddled
+ push @sql, $self->_sqlcase($_);
+ }
+ }
+
+ my $sql = join ' ', @sql;
+
+ # this is pretty tricky
+ # if ask for an array, return ($stmt, @bind)
+ # otherwise, s/?/shift @sqlv/ to put it inline
+ if (wantarray) {
+ return ($sql, @sqlv);
+ } else {
+ 1 while $sql =~ s/\?/my $d = shift(@sqlv);
+ ref $d ? $d->[1] : $d/e;
+ return $sql;
+ }
+}
+
+
+sub DESTROY { 1 }
+
+sub AUTOLOAD {
+ # This allows us to check for a local, then _form, attr
+ my $self = shift;
+ my($name) = $AUTOLOAD =~ /.*::(.+)/;
+ return $self->generate($name, @_);
+}
+
+1;
+
+
+
+__END__
+
+=head1 NAME
+
+SQL::Abstract - Generate SQL from Perl data structures
+
+=head1 SYNOPSIS
+
+ use SQL::Abstract;
+
+ my $sql = SQL::Abstract->new;
+
+ my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order);
+
+ my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values);
+
+ my($stmt, @bind) = $sql->update($table, \%fieldvals, \%where);
+
+ my($stmt, @bind) = $sql->delete($table, \%where);
+
+ # Then, use these in your DBI statements
+ my $sth = $dbh->prepare($stmt);
+ $sth->execute(@bind);
+
+ # Just generate the WHERE clause
+ my($stmt, @bind) = $sql->where(\%where, \@order);
+
+ # Return values in the same order, for hashed queries
+ # See PERFORMANCE section for more details
+ my @bind = $sql->values(\%fieldvals);
+
+=head1 DESCRIPTION
+
+This module was inspired by the excellent L<DBIx::Abstract>.
+However, in using that module I found that what I really wanted
+to do was generate SQL, but still retain complete control over my
+statement handles and use the DBI interface. So, I set out to
+create an abstract SQL generation module.
+
+While based on the concepts used by L<DBIx::Abstract>, there are
+several important differences, especially when it comes to WHERE
+clauses. I have modified the concepts used to make the SQL easier
+to generate from Perl data structures and, IMO, more intuitive.
+The underlying idea is for this module to do what you mean, based
+on the data structures you provide it. The big advantage is that
+you don't have to modify your code every time your data changes,
+as this module figures it out.
+
+To begin with, an SQL INSERT is as easy as just specifying a hash
+of C<key=value> pairs:
+
+ my %data = (
+ name => 'Jimbo Bobson',
+ phone => '123-456-7890',
+ address => '42 Sister Lane',
+ city => 'St. Louis',
+ state => 'Louisiana',
+ );
+
+The SQL can then be generated with this:
+
+ my($stmt, @bind) = $sql->insert('people', \%data);
+
+Which would give you something like this:
+
+ $stmt = "INSERT INTO people
+ (address, city, name, phone, state)
+ VALUES (?, ?, ?, ?, ?)";
+ @bind = ('42 Sister Lane', 'St. Louis', 'Jimbo Bobson',
+ '123-456-7890', 'Louisiana');
+
+These are then used directly in your DBI code:
+
+ my $sth = $dbh->prepare($stmt);
+ $sth->execute(@bind);
+
+=head2 Inserting and Updating Arrays
+
+If your database has array types (like for example Postgres),
+activate the special option C<< array_datatypes => 1 >>
+when creating the C<SQL::Abstract> object.
+Then you may use an arrayref to insert and update database array types:
+
+ my $sql = SQL::Abstract->new(array_datatypes => 1);
+ my %data = (
+ planets => [qw/Mercury Venus Earth Mars/]
+ );
+
+ my($stmt, @bind) = $sql->insert('solar_system', \%data);
+
+This results in:
+
+ $stmt = "INSERT INTO solar_system (planets) VALUES (?)"
+
+ @bind = (['Mercury', 'Venus', 'Earth', 'Mars']);
+
+
+=head2 Inserting and Updating SQL
+
+In order to apply SQL functions to elements of your C<%data> you may
+specify a reference to an arrayref for the given hash value. For example,
+if you need to execute the Oracle C<to_date> function on a value, you can
+say something like this:
+
+ my %data = (
+ name => 'Bill',
+ date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"],
+ );
+
+The first value in the array is the actual SQL. Any other values are
+optional and would be included in the bind values array. This gives
+you:
+
+ my($stmt, @bind) = $sql->insert('people', \%data);
+
+ $stmt = "INSERT INTO people (name, date_entered)
+ VALUES (?, to_date(?,'MM/DD/YYYY'))";
+ @bind = ('Bill', '03/02/2003');
+
+An UPDATE is just as easy, all you change is the name of the function:
+
+ my($stmt, @bind) = $sql->update('people', \%data);
+
+Notice that your C<%data> isn't touched; the module will generate
+the appropriately quirky SQL for you automatically. Usually you'll
+want to specify a WHERE clause for your UPDATE, though, which is
+where handling C<%where> hashes comes in handy...
+
+=head2 Complex where statements
+
+This module can generate pretty complicated WHERE statements
+easily. For example, simple C<key=value> pairs are taken to mean
+equality, and if you want to see if a field is within a set
+of values, you can use an arrayref. Let's say we wanted to
+SELECT some data based on this criteria:
+
+ my %where = (
+ requestor => 'inna',
+ worker => ['nwiger', 'rcwe', 'sfz'],
+ status => { '!=', 'completed' }
+ );
+
+ my($stmt, @bind) = $sql->select('tickets', '*', \%where);
+
+The above would give you something like this:
+
+ $stmt = "SELECT * FROM tickets WHERE
+ ( requestor = ? ) AND ( status != ? )
+ AND ( worker = ? OR worker = ? OR worker = ? )";
+ @bind = ('inna', 'completed', 'nwiger', 'rcwe', 'sfz');
+
+Which you could then use in DBI code like so:
+
+ my $sth = $dbh->prepare($stmt);
+ $sth->execute(@bind);
+
+Easy, eh?
+
+=head1 FUNCTIONS
+
+The functions are simple. There's one for each major SQL operation,
+and a constructor you use first. The arguments are specified in a
+similar order to each function (table, then fields, then a where
+clause) to try and simplify things.
+
+
+
+
+=head2 new(option => 'value')
+
+The C<new()> function takes a list of options and values, and returns
+a new B<SQL::Abstract> object which can then be used to generate SQL
+through the methods below. The options accepted are:
+
+=over
+
+=item case
+
+If set to 'lower', then SQL will be generated in all lowercase. By
+default SQL is generated in "textbook" case meaning something like:
+
+ SELECT a_field FROM a_table WHERE some_field LIKE '%someval%'
+
+Any setting other than 'lower' is ignored.
+
+=item cmp
+
+This determines what the default comparison operator is. By default
+it is C<=>, meaning that a hash like this:
+
+ %where = (name => 'nwiger', email => 'nate at wiger.org');
+
+Will generate SQL like this:
+
+ WHERE name = 'nwiger' AND email = 'nate at wiger.org'
+
+However, you may want loose comparisons by default, so if you set
+C<cmp> to C<like> you would get SQL such as:
+
+ WHERE name like 'nwiger' AND email like 'nate at wiger.org'
+
+You can also override the comparsion on an individual basis - see
+the huge section on L</"WHERE CLAUSES"> at the bottom.
+
+=item sqltrue, sqlfalse
+
+Expressions for inserting boolean values within SQL statements.
+By default these are C<1=1> and C<1=0>.
+
+=item logic
+
+This determines the default logical operator for multiple WHERE
+statements in arrays. By default it is "or", meaning that a WHERE
+array of the form:
+
+ @where = (
+ event_date => {'>=', '2/13/99'},
+ event_date => {'<=', '4/24/03'},
+ );
+
+Will generate SQL like this:
+
+ WHERE event_date >= '2/13/99' OR event_date <= '4/24/03'
+
+This is probably not what you want given this query, though (look
+at the dates). To change the "OR" to an "AND", simply specify:
+
+ my $sql = SQL::Abstract->new(logic => 'and');
+
+Which will change the above C<WHERE> to:
+
+ WHERE event_date >= '2/13/99' AND event_date <= '4/24/03'
+
+The logic can also be changed locally by inserting
+an extra first element in the array :
+
+ @where = (-and => event_date => {'>=', '2/13/99'},
+ event_date => {'<=', '4/24/03'} );
+
+See the L</"WHERE CLAUSES"> section for explanations.
+
+=item convert
+
+This will automatically convert comparisons using the specified SQL
+function for both column and value. This is mostly used with an argument
+of C<upper> or C<lower>, so that the SQL will have the effect of
+case-insensitive "searches". For example, this:
+
+ $sql = SQL::Abstract->new(convert => 'upper');
+ %where = (keywords => 'MaKe iT CAse inSeNSItive');
+
+Will turn out the following SQL:
+
+ WHERE upper(keywords) like upper('MaKe iT CAse inSeNSItive')
+
+The conversion can be C<upper()>, C<lower()>, or any other SQL function
+that can be applied symmetrically to fields (actually B<SQL::Abstract> does
+not validate this option; it will just pass through what you specify verbatim).
+
+=item bindtype
+
+This is a kludge because many databases suck. For example, you can't
+just bind values using DBI's C<execute()> for Oracle C<CLOB> or C<BLOB> fields.
+Instead, you have to use C<bind_param()>:
+
+ $sth->bind_param(1, 'reg data');
+ $sth->bind_param(2, $lots, {ora_type => ORA_CLOB});
+
+The problem is, B<SQL::Abstract> will normally just return a C<@bind> array,
+which loses track of which field each slot refers to. Fear not.
+
+If you specify C<bindtype> in new, you can determine how C<@bind> is returned.
+Currently, you can specify either C<normal> (default) or C<columns>. If you
+specify C<columns>, you will get an array that looks like this:
+
+ my $sql = SQL::Abstract->new(bindtype => 'columns');
+ my($stmt, @bind) = $sql->insert(...);
+
+ @bind = (
+ [ 'column1', 'value1' ],
+ [ 'column2', 'value2' ],
+ [ 'column3', 'value3' ],
+ );
+
+You can then iterate through this manually, using DBI's C<bind_param()>.
+
+ $sth->prepare($stmt);
+ my $i = 1;
+ for (@bind) {
+ my($col, $data) = @$_;
+ if ($col eq 'details' || $col eq 'comments') {
+ $sth->bind_param($i, $data, {ora_type => ORA_CLOB});
+ } elsif ($col eq 'image') {
+ $sth->bind_param($i, $data, {ora_type => ORA_BLOB});
+ } else {
+ $sth->bind_param($i, $data);
+ }
+ $i++;
+ }
+ $sth->execute; # execute without @bind now
+
+Now, why would you still use B<SQL::Abstract> if you have to do this crap?
+Basically, the advantage is still that you don't have to care which fields
+are or are not included. You could wrap that above C<for> loop in a simple
+sub called C<bind_fields()> or something and reuse it repeatedly. You still
+get a layer of abstraction over manual SQL specification.
+
+=item quote_char
+
+This is the character that a table or column name will be quoted
+with. By default this is an empty string, but you could set it to
+the character C<`>, to generate SQL like this:
+
+ SELECT `a_field` FROM `a_table` WHERE `some_field` LIKE '%someval%'
+
+Alternatively, you can supply an array ref of two items, the first being the left
+hand quote character, and the second the right hand quote character. For
+example, you could supply C<['[',']']> for SQL Server 2000 compliant quotes
+that generates SQL like this:
+
+ SELECT [a_field] FROM [a_table] WHERE [some_field] LIKE '%someval%'
+
+Quoting is useful if you have tables or columns names that are reserved
+words in your database's SQL dialect.
+
+=item name_sep
+
+This is the character that separates a table and column name. It is
+necessary to specify this when the C<quote_char> option is selected,
+so that tables and column names can be individually quoted like this:
+
+ SELECT `table`.`one_field` FROM `table` WHERE `table`.`other_field` = 1
+
+=item array_datatypes
+
+When this option is true, arrayrefs in INSERT or UPDATE are
+interpreted as array datatypes and are passed directly
+to the DBI layer.
+When this option is false, arrayrefs are interpreted
+as literal SQL, just like refs to arrayrefs
+(but this behavior is for backwards compatibility; when writing
+new queries, use the "reference to arrayref" syntax
+for literal SQL).
+
+
+=item special_ops
+
+Takes a reference to a list of "special operators"
+to extend the syntax understood by L<SQL::Abstract>.
+See section L</"SPECIAL OPERATORS"> for details.
+
+
+
+=back
+
+=head2 insert($table, \@values || \%fieldvals)
+
+This is the simplest function. You simply give it a table name
+and either an arrayref of values or hashref of field/value pairs.
+It returns an SQL INSERT statement and a list of bind values.
+See the sections on L</"Inserting and Updating Arrays"> and
+L</"Inserting and Updating SQL"> for information on how to insert
+with those data types.
+
+=head2 update($table, \%fieldvals, \%where)
+
+This takes a table, hashref of field/value pairs, and an optional
+hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list
+of bind values.
+See the sections on L</"Inserting and Updating Arrays"> and
+L</"Inserting and Updating SQL"> for information on how to insert
+with those data types.
+
+=head2 select($source, $fields, $where, $order)
+
+This returns a SQL SELECT statement and associated list of bind values, as
+specified by the arguments :
+
+=over
+
+=item $source
+
+Specification of the 'FROM' part of the statement.
+The argument can be either a plain scalar (interpreted as a table
+name, will be quoted), or an arrayref (interpreted as a list
+of table names, joined by commas, quoted), or a scalarref
+(literal table name, not quoted), or a ref to an arrayref
+(list of literal table names, joined by commas, not quoted).
+
+=item $fields
+
+Specification of the list of fields to retrieve from
+the source.
+The argument can be either an arrayref (interpreted as a list
+of field names, will be joined by commas and quoted), or a
+plain scalar (literal SQL, not quoted).
+Please observe that this API is not as flexible as for
+the first argument <$table>, for backwards compatibility reasons.
+
+=item $where
+
+Optional argument to specify the WHERE part of the query.
+The argument is most often a hashref, but can also be
+an arrayref or plain scalar --
+see section L<WHERE clause|/"WHERE CLAUSES"> for details.
+
+=item $order
+
+Optional argument to specify the ORDER BY part of the query.
+The argument can be a scalar, a hashref or an arrayref
+-- see section L<ORDER BY clause|/"ORDER BY CLAUSES">
+for details.
+
+=back
+
+
+=head2 delete($table, \%where)
+
+This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>.
+It returns an SQL DELETE statement and list of bind values.
+
+=head2 where(\%where, \@order)
+
+This is used to generate just the WHERE clause. For example,
+if you have an arbitrary data structure and know what the
+rest of your SQL is going to look like, but want an easy way
+to produce a WHERE clause, use this. It returns an SQL WHERE
+clause and list of bind values.
+
+
+=head2 values(\%data)
+
+This just returns the values from the hash C<%data>, in the same
+order that would be returned from any of the other above queries.
+Using this allows you to markedly speed up your queries if you
+are affecting lots of rows. See below under the L</"PERFORMANCE"> section.
+
+=head2 generate($any, 'number', $of, \@data, $struct, \%types)
+
+Warning: This is an experimental method and subject to change.
+
+This returns arbitrarily generated SQL. It's a really basic shortcut.
+It will return two different things, depending on return context:
+
+ my($stmt, @bind) = $sql->generate('create table', \$table, \@fields);
+ my $stmt_and_val = $sql->generate('create table', \$table, \@fields);
+
+These would return the following:
+
+ # First calling form
+ $stmt = "CREATE TABLE test (?, ?)";
+ @bind = (field1, field2);
+
+ # Second calling form
+ $stmt_and_val = "CREATE TABLE test (field1, field2)";
+
+Depending on what you're trying to do, it's up to you to choose the correct
+format. In this example, the second form is what you would want.
+
+By the same token:
+
+ $sql->generate('alter session', { nls_date_format => 'MM/YY' });
+
+Might give you:
+
+ ALTER SESSION SET nls_date_format = 'MM/YY'
+
+You get the idea. Strings get their case twiddled, but everything
+else remains verbatim.
+
+
+
+
+=head1 WHERE CLAUSES
+
+=head2 Introduction
+
+This module uses a variation on the idea from L<DBIx::Abstract>. It
+is B<NOT>, repeat I<not> 100% compatible. B<The main logic of this
+module is that things in arrays are OR'ed, and things in hashes
+are AND'ed.>
+
+The easiest way to explain is to show lots of examples. After
+each C<%where> hash shown, it is assumed you used:
+
+ my($stmt, @bind) = $sql->where(\%where);
+
+However, note that the C<%where> hash can be used directly in any
+of the other functions as well, as described above.
+
+=head2 Key-value pairs
+
+So, let's get started. To begin, a simple hash:
+
+ my %where = (
+ user => 'nwiger',
+ status => 'completed'
+ );
+
+Is converted to SQL C<key = val> statements:
+
+ $stmt = "WHERE user = ? AND status = ?";
+ @bind = ('nwiger', 'completed');
+
+One common thing I end up doing is having a list of values that
+a field can be in. To do this, simply specify a list inside of
+an arrayref:
+
+ my %where = (
+ user => 'nwiger',
+ status => ['assigned', 'in-progress', 'pending'];
+ );
+
+This simple code will create the following:
+
+ $stmt = "WHERE user = ? AND ( status = ? OR status = ? OR status = ? )";
+ @bind = ('nwiger', 'assigned', 'in-progress', 'pending');
+
+An empty arrayref will be considered a logical false and
+will generate 0=1.
+
+=head2 Key-value pairs
+
+If you want to specify a different type of operator for your comparison,
+you can use a hashref for a given column:
+
+ my %where = (
+ user => 'nwiger',
+ status => { '!=', 'completed' }
+ );
+
+Which would generate:
+
+ $stmt = "WHERE user = ? AND status != ?";
+ @bind = ('nwiger', 'completed');
+
+To test against multiple values, just enclose the values in an arrayref:
+
+ status => { '!=', ['assigned', 'in-progress', 'pending'] };
+
+Which would give you:
+
+ "WHERE status != ? AND status != ? AND status != ?"
+
+Notice that since the operator was recognized as being a 'negative'
+operator, the arrayref was interpreted with 'AND' logic (because
+of Morgan's laws). By contrast, the reverse
+
+ status => { '=', ['assigned', 'in-progress', 'pending'] };
+
+would generate :
+
+ "WHERE status = ? OR status = ? OR status = ?"
+
+
+The hashref can also contain multiple pairs, in which case it is expanded
+into an C<AND> of its elements:
+
+ my %where = (
+ user => 'nwiger',
+ status => { '!=', 'completed', -not_like => 'pending%' }
+ );
+
+ # Or more dynamically, like from a form
+ $where{user} = 'nwiger';
+ $where{status}{'!='} = 'completed';
+ $where{status}{'-not_like'} = 'pending%';
+
+ # Both generate this
+ $stmt = "WHERE user = ? AND status != ? AND status NOT LIKE ?";
+ @bind = ('nwiger', 'completed', 'pending%');
+
+
+To get an OR instead, you can combine it with the arrayref idea:
+
+ my %where => (
+ user => 'nwiger',
+ priority => [ {'=', 2}, {'!=', 1} ]
+ );
+
+Which would generate:
+
+ $stmt = "WHERE user = ? AND priority = ? OR priority != ?";
+ @bind = ('nwiger', '2', '1');
+
+
+=head2 Logic and nesting operators
+
+In the example above,
+there is a subtle trap if you want to say something like
+this (notice the C<AND>):
+
+ WHERE priority != ? AND priority != ?
+
+Because, in Perl you I<can't> do this:
+
+ priority => { '!=', 2, '!=', 1 }
+
+As the second C<!=> key will obliterate the first. The solution
+is to use the special C<-modifier> form inside an arrayref:
+
+ priority => [ -and => {'!=', 2},
+ {'!=', 1} ]
+
+
+Normally, these would be joined by C<OR>, but the modifier tells it
+to use C<AND> instead. (Hint: You can use this in conjunction with the
+C<logic> option to C<new()> in order to change the way your queries
+work by default.) B<Important:> Note that the C<-modifier> goes
+B<INSIDE> the arrayref, as an extra first element. This will
+B<NOT> do what you think it might:
+
+ priority => -and => [{'!=', 2}, {'!=', 1}] # WRONG!
+
+Here is a quick list of equivalencies, since there is some overlap:
+
+ # Same
+ status => {'!=', 'completed', 'not like', 'pending%' }
+ status => [ -and => {'!=', 'completed'}, {'not like', 'pending%'}]
+
+ # Same
+ status => {'=', ['assigned', 'in-progress']}
+ status => [ -or => {'=', 'assigned'}, {'=', 'in-progress'}]
+ status => [ {'=', 'assigned'}, {'=', 'in-progress'} ]
+
+In addition to C<-and> and C<-or>, there is also a special C<-nest>
+operator which adds an additional set of parens, to create a subquery.
+For example, to get something like this:
+
+ $stmt = "WHERE user = ? AND ( workhrs > ? OR geo = ? )";
+ @bind = ('nwiger', '20', 'ASIA');
+
+You would do:
+
+ my %where = (
+ user => 'nwiger',
+ -nest => [ workhrs => {'>', 20}, geo => 'ASIA' ],
+ );
+
+=head2 Special operators : IN, BETWEEN, etc.
+
+You can also use the hashref format to compare a list of fields using the
+C<IN> comparison operator, by specifying the list as an arrayref:
+
+ my %where = (
+ status => 'completed',
+ reportid => { -in => [567, 2335, 2] }
+ );
+
+Which would generate:
+
+ $stmt = "WHERE status = ? AND reportid IN (?,?,?)";
+ @bind = ('completed', '567', '2335', '2');
+
+The reverse operator C<-not_in> generates SQL C<NOT IN> and is used in
+the same way.
+
+Another pair of operators is C<-between> and C<-not_between>,
+used with an arrayref of two values:
+
+ my %where = (
+ user => 'nwiger',
+ completion_date => {
+ -not_between => ['2002-10-01', '2003-02-06']
+ }
+ );
+
+Would give you:
+
+ WHERE user = ? AND completion_date NOT BETWEEN ( ? AND ? )
+
+These are the two builtin "special operators"; but the
+list can be expanded : see section L</"SPECIAL OPERATORS"> below.
+
+=head2 Nested conditions
+
+So far, we've seen how multiple conditions are joined with a top-level
+C<AND>. We can change this by putting the different conditions we want in
+hashes and then putting those hashes in an array. For example:
+
+ my @where = (
+ {
+ user => 'nwiger',
+ status => { -like => ['pending%', 'dispatched'] },
+ },
+ {
+ user => 'robot',
+ status => 'unassigned',
+ }
+ );
+
+This data structure would create the following:
+
+ $stmt = "WHERE ( user = ? AND ( status LIKE ? OR status LIKE ? ) )
+ OR ( user = ? AND status = ? ) )";
+ @bind = ('nwiger', 'pending', 'dispatched', 'robot', 'unassigned');
+
+This can be combined with the C<-nest> operator to properly group
+SQL statements:
+
+ my @where = (
+ -and => [
+ user => 'nwiger',
+ -nest => [
+ -and => [workhrs => {'>', 20}, geo => 'ASIA' ],
+ -and => [workhrs => {'<', 50}, geo => 'EURO' ]
+ ],
+ ],
+ );
+
+That would yield:
+
+ WHERE ( user = ? AND
+ ( ( workhrs > ? AND geo = ? )
+ OR ( workhrs < ? AND geo = ? ) ) )
+
+=head2 Literal SQL
+
+Finally, sometimes only literal SQL will do. If you want to include
+literal SQL verbatim, you can specify it as a scalar reference, namely:
+
+ my $inn = 'is Not Null';
+ my %where = (
+ priority => { '<', 2 },
+ requestor => \$inn
+ );
+
+This would create:
+
+ $stmt = "WHERE priority < ? AND requestor is Not Null";
+ @bind = ('2');
+
+Note that in this example, you only get one bind parameter back, since
+the verbatim SQL is passed as part of the statement.
+
+Of course, just to prove a point, the above can also be accomplished
+with this:
+
+ my %where = (
+ priority => { '<', 2 },
+ requestor => { '!=', undef },
+ );
+
+
+TMTOWTDI.
+
+Conditions on boolean columns can be expressed in the
+same way, passing a reference to an empty string :
+
+ my %where = (
+ priority => { '<', 2 },
+ is_ready => \"";
+ );
+
+which yields
+
+ $stmt = "WHERE priority < ? AND is_ready";
+ @bind = ('2');
+
+
+=head2 Literal SQL with placeholders and bind values (subqueries)
+
+If the literal SQL to be inserted has placeholders and bind values,
+use a reference to an arrayref (yes this is a double reference --
+not so common, but perfectly legal Perl). For example, to find a date
+in Postgres you can use something like this:
+
+ my %where = (
+ date_column => \[q/= date '2008-09-30' - ?::integer/, 10/]
+ )
+
+This would create:
+
+ $stmt = "WHERE ( date_column = date \'2008-09-30\' - ?::integer )"
+ @bind = ('10');
+
+
+Literal SQL is especially useful for nesting parenthesized clauses in the
+main SQL query. Here is a first example :
+
+ my ($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
+ 100, "foo%");
+ my %where = (
+ foo => 1234,
+ bar => \["IN ($sub_stmt)" => @sub_bind],
+ );
+
+This yields :
+
+ $stmt = "WHERE (foo = ? AND bar IN (SELECT c1 FROM t1
+ WHERE c2 < ? AND c3 LIKE ?))";
+ @bind = (1234, 100, "foo%");
+
+Other subquery operators, like for example C<"E<gt> ALL"> or C<"NOT IN">,
+are expressed in the same way. Of course the C<$sub_stmt> and
+its associated bind values can be generated through a former call
+to C<select()> :
+
+ my ($sub_stmt, @sub_bind)
+ = $sql->select("t1", "c1", {c2 => {"<" => 100},
+ c3 => {-like => "foo%"}});
+ my %where = (
+ foo => 1234,
+ bar => \["> ALL ($sub_stmt)" => @sub_bind],
+ );
+
+In the examples above, the subquery was used as an operator on a column;
+but the same principle also applies for a clause within the main C<%where>
+hash, like an EXISTS subquery :
+
+ my ($sub_stmt, @sub_bind)
+ = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
+ my %where = (
+ foo => 1234,
+ -nest => \["EXISTS ($sub_stmt)" => @sub_bind],
+ );
+
+which yields
+
+ $stmt = "WHERE (foo = ? AND EXISTS (SELECT * FROM t1
+ WHERE c1 = ? AND c2 > t0.c0))";
+ @bind = (1234, 1);
+
+
+Observe that the condition on C<c2> in the subquery refers to
+column C<t0.c0> of the main query : this is I<not> a bind
+value, so we have to express it through a scalar ref.
+Writing C<< c2 => {">" => "t0.c0"} >> would have generated
+C<< c2 > ? >> with bind value C<"t0.c0"> ... not exactly
+what we wanted here.
+
+Another use of the subquery technique is when some SQL clauses need
+parentheses, as it often occurs with some proprietary SQL extensions
+like for example fulltext expressions, geospatial expressions,
+NATIVE clauses, etc. Here is an example of a fulltext query in MySQL :
+
+ my %where = (
+ -nest => \["MATCH (col1, col2) AGAINST (?)" => qw/apples/]
+ );
+
+Finally, here is an example where a subquery is used
+for expressing unary negation:
+
+ my ($sub_stmt, @sub_bind)
+ = $sql->where({age => [{"<" => 10}, {">" => 20}]});
+ $sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
+ my %where = (
+ lname => {like => '%son%'},
+ -nest => \["NOT ($sub_stmt)" => @sub_bind],
+ );
+
+This yields
+
+ $stmt = "lname LIKE ? AND NOT ( age < ? OR age > ? )"
+ @bind = ('%son%', 10, 20)
+
+
+
+=head2 Conclusion
+
+These pages could go on for a while, since the nesting of the data
+structures this module can handle are pretty much unlimited (the
+module implements the C<WHERE> expansion as a recursive function
+internally). Your best bet is to "play around" with the module a
+little to see how the data structures behave, and choose the best
+format for your data based on that.
+
+And of course, all the values above will probably be replaced with
+variables gotten from forms or the command line. After all, if you
+knew everything ahead of time, you wouldn't have to worry about
+dynamically-generating SQL and could just hardwire it into your
+script.
+
+
+
+
+=head1 ORDER BY CLAUSES
+
+Some functions take an order by clause. This can either be a scalar (just a
+column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>,
+or an array of either of the two previous forms. Examples:
+
+ Given | Will Generate
+ ----------------------------------------------------------
+ \'colA DESC' | ORDER BY colA DESC
+ 'colA' | ORDER BY colA
+ [qw/colA colB/] | ORDER BY colA, colB
+ {-asc => 'colA'} | ORDER BY colA ASC
+ {-desc => 'colB'} | ORDER BY colB DESC
+ [ |
+ {-asc => 'colA'}, | ORDER BY colA ASC, colB DESC
+ {-desc => 'colB'} |
+ ] |
+ [colA => {-asc => 'colB'}] | ORDER BY colA, colB ASC
+ ==========================================================
+
+
+
+=head1 SPECIAL OPERATORS
+
+[to be written]
+
+
+=head1 TABLES AND JOINS
+
+[to be written]
+
+
+=head1 PERFORMANCE
+
+Thanks to some benchmarking by Mark Stosberg, it turns out that
+this module is many orders of magnitude faster than using C<DBIx::Abstract>.
+I must admit this wasn't an intentional design issue, but it's a
+byproduct of the fact that you get to control your C<DBI> handles
+yourself.
+
+To maximize performance, use a code snippet like the following:
+
+ # prepare a statement handle using the first row
+ # and then reuse it for the rest of the rows
+ my($sth, $stmt);
+ for my $href (@array_of_hashrefs) {
+ $stmt ||= $sql->insert('table', $href);
+ $sth ||= $dbh->prepare($stmt);
+ $sth->execute($sql->values($href));
+ }
+
+The reason this works is because the keys in your C<$href> are sorted
+internally by B<SQL::Abstract>. Thus, as long as your data retains
+the same structure, you only have to generate the SQL the first time
+around. On subsequent queries, simply use the C<values> function provided
+by this module to return your values in the correct order.
+
+
+=head1 FORMBUILDER
+
+If you use my C<CGI::FormBuilder> module at all, you'll hopefully
+really like this part (I do, at least). Building up a complex query
+can be as simple as the following:
+
+ #!/usr/bin/perl
+
+ use CGI::FormBuilder;
+ use SQL::Abstract;
+
+ my $form = CGI::FormBuilder->new(...);
+ my $sql = SQL::Abstract->new;
+
+ if ($form->submitted) {
+ my $field = $form->field;
+ my $id = delete $field->{id};
+ my($stmt, @bind) = $sql->update('table', $field, {id => $id});
+ }
+
+Of course, you would still have to connect using C<DBI> to run the
+query, but the point is that if you make your form look like your
+table, the actual query script can be extremely simplistic.
+
+If you're B<REALLY> lazy (I am), check out C<HTML::QuickTable> for
+a fast interface to returning and formatting data. I frequently
+use these three modules together to write complex database query
+apps in under 50 lines.
+
+
+=head1 CHANGES
+
+Version 1.50 was a major internal refactoring of C<SQL::Abstract>.
+Great care has been taken to preserve the I<published> behavior
+documented in previous versions in the 1.* family; however,
+some features that were previously undocumented, or behaved
+differently from the documentation, had to be changed in order
+to clarify the semantics. Hence, client code that was relying
+on some dark areas of C<SQL::Abstract> v1.*
+B<might behave differently> in v1.50.
+
+=head1 Public changes
+
+=over
+
+=item *
+
+support for literal SQL through the C<< \ [$sql, bind] >> syntax.
+
+=item *
+
+added -nest1, -nest2 or -nest_1, -nest_2, ...
+
+=item *
+
+optional support for L<array datatypes|/"Inserting and Updating Arrays">
+
+=item *
+
+defensive programming : check arguments
+
+=item *
+
+fixed bug with global logic, which was previously implemented
+through global variables yielding side-effects. Prior versons would
+interpret C<< [ {cond1, cond2}, [cond3, cond4] ] >>
+as C<< "(cond1 AND cond2) OR (cond3 AND cond4)" >>.
+Now this is interpreted
+as C<< "(cond1 AND cond2) OR (cond3 OR cond4)" >>.
+
+=item *
+
+C<-and> / C<-or> operators are no longer accepted
+in the middle of an arrayref : they are
+only admitted if in first position.
+
+=item *
+
+changed logic for distributing an op over arrayrefs
+
+=item *
+
+fixed semantics of _bindtype on array args
+
+=item *
+
+dropped the C<_anoncopy> of the %where tree. No longer necessary,
+we just avoid shifting arrays within that tree.
+
+=item *
+
+dropped the C<_modlogic> function
+
+=back
+
+
+
+=head1 ACKNOWLEDGEMENTS
+
+There are a number of individuals that have really helped out with
+this module. Unfortunately, most of them submitted bugs via CPAN
+so I have no idea who they are! But the people I do know are:
+
+ Ash Berlin (order_by hash term support)
+ Matt Trout (DBIx::Class support)
+ Mark Stosberg (benchmarking)
+ Chas Owens (initial "IN" operator support)
+ Philip Collins (per-field SQL functions)
+ Eric Kolve (hashref "AND" support)
+ Mike Fragassi (enhancements to "BETWEEN" and "LIKE")
+ Dan Kubb (support for "quote_char" and "name_sep")
+ Guillermo Roditi (patch to cleanup "IN" and "BETWEEN", fix and tests for _order_by)
+ Laurent Dami (internal refactoring, multiple -nest, extensible list of special operators, literal SQL)
+
+Thanks!
+
+=head1 SEE ALSO
+
+L<DBIx::Class>, L<DBIx::Abstract>, L<CGI::FormBuilder>, L<HTML::QuickTable>.
+
+=head1 AUTHOR
+
+Copyright (c) 2001-2007 Nathan Wiger <nwiger at cpan.org>. All Rights Reserved.
+
+This module is actively maintained by Matt Trout <mst at shadowcatsystems.co.uk>
+
+For support, your best bet is to try the C<DBIx::Class> users mailing list.
+While not an official support venue, C<DBIx::Class> makes heavy use of
+C<SQL::Abstract>, and as such list members there are very familiar with
+how to create queries.
+
+This module is free software; you may copy this under the terms of
+the GNU General Public License, or the Artistic License, copies of
+which should have accompanied your Perl kit.
+
+=cut
+
Added: SQL-Abstract/1.x/branches/1.50_RC/t/00new.t
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC/t/00new.t (rev 0)
+++ SQL-Abstract/1.x/branches/1.50_RC/t/00new.t 2008-10-16 22:49:55 UTC (rev 4926)
@@ -0,0 +1,129 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+
+use FindBin;
+use lib "$FindBin::Bin";
+use TestSqlAbstract;
+
+
+plan tests => 15;
+
+use_ok('SQL::Abstract');
+
+#LDNOTE: renamed all "bind" into "where" because that's what they are
+
+
+my @handle_tests = (
+ #1
+ {
+ args => {logic => 'OR'},
+# stmt => 'SELECT * FROM test WHERE ( a = ? OR b = ? )'
+# LDNOTE: modified the line above (changing the test suite!!!) because
+# the test was not consistent with the doc: hashrefs should not be
+# influenced by the current logic, they always mean 'AND'. So
+# { a => 4, b => 0} should ALWAYS mean ( a = ? AND b = ? ).
+ stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )'
+ },
+ #2
+ {
+ args => {},
+ stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )'
+ },
+ #3
+ {
+ args => {case => "upper"},
+ stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )'
+ },
+ #4
+ {
+ args => {case => "upper", cmp => "="},
+ stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )'
+ },
+ #5
+ {
+ args => {cmp => "=", logic => 'or'},
+# LDNOTE idem
+# stmt => 'SELECT * FROM test WHERE ( a = ? OR b = ? )'
+ stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )'
+ },
+ #6
+ {
+ args => {cmp => "like"},
+ stmt => 'SELECT * FROM test WHERE ( a LIKE ? AND b LIKE ? )'
+ },
+ #7
+ {
+ args => {logic => "or", cmp => "like"},
+# LDNOTE idem
+# stmt => 'SELECT * FROM test WHERE ( a LIKE ? OR b LIKE ? )'
+ stmt => 'SELECT * FROM test WHERE ( a LIKE ? AND b LIKE ? )'
+ },
+ #8
+ {
+ args => {case => "lower"},
+ stmt => 'select * from test where ( a = ? and b = ? )'
+ },
+ #9
+ {
+ args => {case => "lower", cmp => "="},
+ stmt => 'select * from test where ( a = ? and b = ? )'
+ },
+ #10
+ {
+ args => {case => "lower", cmp => "like"},
+ stmt => 'select * from test where ( a like ? and b like ? )'
+ },
+ #11
+ {
+ args => {case => "lower", convert => "lower", cmp => "like"},
+ stmt => 'select * from test where ( lower(a) like lower(?) and lower(b) like lower(?) )'
+ },
+ #12
+ {
+ args => {convert => "Round"},
+ stmt => 'SELECT * FROM test WHERE ( ROUND(a) = ROUND(?) AND ROUND(b) = ROUND(?) )',
+ },
+ #13
+ {
+ args => {convert => "lower"},
+ stmt => 'SELECT * FROM test WHERE ( ( LOWER(ticket) = LOWER(?) ) OR ( LOWER(hostname) = LOWER(?) ) OR ( LOWER(taco) = LOWER(?) ) OR ( LOWER(salami) = LOWER(?) ) )',
+ where => [ { ticket => 11 }, { hostname => 11 }, { taco => 'salad' }, { salami => 'punch' } ],
+ },
+ #14
+ {
+ args => {convert => "upper"},
+# LDNOTE : modified the test below, because modified the semantics
+# of "e => { '!=', [qw(f g)] }" : generating "e != 'f' OR e != 'g'"
+# is nonsense (will always be true whatever the value of e). Since
+# this is a 'negative' operator, we must apply the Morgan laws and
+# interpret it as "e != 'f' AND e != 'g'" (and actually the user
+# should rather write "e => {-not_in => [qw/f g/]}".
+
+# stmt => 'SELECT * FROM test WHERE ( ( UPPER(hostname) IN ( UPPER(?), UPPER(?), UPPER(?), UPPER(?) ) AND ( ( UPPER(ticket) = UPPER(?) ) OR ( UPPER(ticket) = UPPER(?) ) OR ( UPPER(ticket) = UPPER(?) ) ) ) OR ( UPPER(tack) BETWEEN UPPER(?) AND UPPER(?) ) OR ( ( ( UPPER(a) = UPPER(?) ) OR ( UPPER(a) = UPPER(?) ) OR ( UPPER(a) = UPPER(?) ) ) AND ( ( UPPER(e) != UPPER(?) ) OR ( UPPER(e) != UPPER(?) ) ) AND UPPER(q) NOT IN ( UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?) ) ) )',
+ stmt => 'SELECT * FROM test WHERE ( ( UPPER(hostname) IN ( UPPER(?), UPPER(?), UPPER(?), UPPER(?) ) AND ( ( UPPER(ticket) = UPPER(?) ) OR ( UPPER(ticket) = UPPER(?) ) OR ( UPPER(ticket) = UPPER(?) ) ) ) OR ( UPPER(tack) BETWEEN UPPER(?) AND UPPER(?) ) OR ( ( ( UPPER(a) = UPPER(?) ) OR ( UPPER(a) = UPPER(?) ) OR ( UPPER(a) = UPPER(?) ) ) AND ( ( UPPER(e) != UPPER(?) ) AND ( UPPER(e) != UPPER(?) ) ) AND UPPER(q) NOT IN ( UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?) ) ) )',
+ where => [ { ticket => [11, 12, 13],
+ hostname => { in => ['ntf', 'avd', 'bvd', '123'] } },
+ { tack => { between => [qw/tick tock/] } },
+ { a => [qw/b c d/],
+ e => { '!=', [qw(f g)] },
+ q => { 'not in', [14..20] } } ],
+ },
+);
+
+for (@handle_tests) {
+ local $" = ', ';
+ #print "creating a handle with args ($_->{args}): ";
+ my $sql = SQL::Abstract->new($_->{args});
+ my $where = $_->{where} || { a => 4, b => 0};
+ my($stmt, @bind) = $sql->select('test', '*', $where);
+
+ # LDNOTE: this original test suite from NWIGER did no comparisons
+ # on @bind values, just checking if @bind is nonempty.
+ # So here we just fake a [1] bind value for the comparison.
+ is_same_sql_bind($stmt, [@bind ? 1 : 0], $_->{stmt}, [1]);
+}
+
+
Added: SQL-Abstract/1.x/branches/1.50_RC/t/01generate.t
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC/t/01generate.t (rev 0)
+++ SQL-Abstract/1.x/branches/1.50_RC/t/01generate.t 2008-10-16 22:49:55 UTC (rev 4926)
@@ -0,0 +1,340 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+
+use FindBin;
+use lib "$FindBin::Bin";
+use TestSqlAbstract;
+
+plan tests => 64;
+
+use SQL::Abstract;
+
+my @tests = (
+ #1
+ {
+ func => 'select',
+ args => ['test', '*'],
+ stmt => 'SELECT * FROM test',
+ stmt_q => 'SELECT * FROM `test`',
+ bind => []
+ },
+ #2
+ {
+ func => 'select',
+ args => ['test', [qw(one two three)]],
+ stmt => 'SELECT one, two, three FROM test',
+ stmt_q => 'SELECT `one`, `two`, `three` FROM `test`',
+ bind => []
+ },
+ #3
+ {
+ func => 'select',
+ args => ['test', '*', { a => 0 }, [qw/boom bada bing/]],
+ stmt => 'SELECT * FROM test WHERE ( a = ? ) ORDER BY boom, bada, bing',
+ stmt_q => 'SELECT * FROM `test` WHERE ( `a` = ? ) ORDER BY `boom`, `bada`, `bing`',
+ bind => [0]
+ },
+ #4
+ {
+ func => 'select',
+ args => ['test', '*', [ { a => 5 }, { b => 6 } ]],
+ stmt => 'SELECT * FROM test WHERE ( ( a = ? ) OR ( b = ? ) )',
+ stmt_q => 'SELECT * FROM `test` WHERE ( ( `a` = ? ) OR ( `b` = ? ) )',
+ bind => [5,6]
+ },
+ #5
+ {
+ func => 'select',
+ args => ['test', '*', undef, ['id']],
+ stmt => 'SELECT * FROM test ORDER BY id',
+ stmt_q => 'SELECT * FROM `test` ORDER BY `id`',
+ bind => []
+ },
+ #6
+ {
+ func => 'select',
+ args => ['test', '*', { a => 'boom' } , ['id']],
+ stmt => 'SELECT * FROM test WHERE ( a = ? ) ORDER BY id',
+ stmt_q => 'SELECT * FROM `test` WHERE ( `a` = ? ) ORDER BY `id`',
+ bind => ['boom']
+ },
+ #7
+ {
+ func => 'select',
+ args => ['test', '*', { a => ['boom', 'bang'] }],
+ stmt => 'SELECT * FROM test WHERE ( ( ( a = ? ) OR ( a = ? ) ) )',
+ stmt_q => 'SELECT * FROM `test` WHERE ( ( ( `a` = ? ) OR ( `a` = ? ) ) )',
+ bind => ['boom', 'bang']
+ },
+ #8
+ {
+ func => 'select',
+ args => [[qw/test1 test2/], '*', { 'test1.a' => { 'In', ['boom', 'bang'] } }],
+ stmt => 'SELECT * FROM test1, test2 WHERE ( test1.a IN ( ?, ? ) )',
+ stmt_q => 'SELECT * FROM `test1`, `test2` WHERE ( `test1`.`a` IN ( ?, ? ) )',
+ bind => ['boom', 'bang']
+ },
+ #9
+ {
+ func => 'select',
+ args => ['test', '*', { a => { 'between', ['boom', 'bang'] } }],
+ stmt => 'SELECT * FROM test WHERE ( a BETWEEN ? AND ? )',
+ stmt_q => 'SELECT * FROM `test` WHERE ( `a` BETWEEN ? AND ? )',
+ bind => ['boom', 'bang']
+ },
+ #10
+ {
+ func => 'select',
+ args => ['test', '*', { a => { '!=', 'boom' } }],
+ stmt => 'SELECT * FROM test WHERE ( a != ? )',
+ stmt_q => 'SELECT * FROM `test` WHERE ( `a` != ? )',
+ bind => ['boom']
+ },
+ #11
+ {
+ func => 'update',
+ args => ['test', {a => 'boom'}, {a => undef}],
+ stmt => 'UPDATE test SET a = ? WHERE ( a IS NULL )',
+ stmt_q => 'UPDATE `test` SET `a` = ? WHERE ( `a` IS NULL )',
+ bind => ['boom']
+ },
+ #12
+ {
+ func => 'update',
+ args => ['test', {a => 'boom'}, { a => {'!=', "bang" }} ],
+ stmt => 'UPDATE test SET a = ? WHERE ( a != ? )',
+ stmt_q => 'UPDATE `test` SET `a` = ? WHERE ( `a` != ? )',
+ bind => ['boom', 'bang']
+ },
+ #13
+ {
+ func => 'update',
+ args => ['test', {'a-funny-flavored-candy' => 'yummy', b => 'oops'}, { a42 => "bang" }],
+ stmt => 'UPDATE test SET a-funny-flavored-candy = ?, b = ? WHERE ( a42 = ? )',
+ stmt_q => 'UPDATE `test` SET `a-funny-flavored-candy` = ?, `b` = ? WHERE ( `a42` = ? )',
+ bind => ['yummy', 'oops', 'bang']
+ },
+ #14
+ {
+ func => 'delete',
+ args => ['test', {requestor => undef}],
+ stmt => 'DELETE FROM test WHERE ( requestor IS NULL )',
+ stmt_q => 'DELETE FROM `test` WHERE ( `requestor` IS NULL )',
+ bind => []
+ },
+ #15
+ {
+ func => 'delete',
+ args => [[qw/test1 test2 test3/],
+ { 'test1.field' => \'!= test2.field',
+ user => {'!=','nwiger'} },
+ ],
+ stmt => 'DELETE FROM test1, test2, test3 WHERE ( test1.field != test2.field AND user != ? )',
+ stmt_q => 'DELETE FROM `test1`, `test2`, `test3` WHERE ( `test1`.`field` != test2.field AND `user` != ? )', # test2.field is a literal value, cannnot be quoted.
+ bind => ['nwiger']
+ },
+ #16
+ {
+ func => 'insert',
+ args => ['test', {a => 1, b => 2, c => 3, d => 4, e => 5}],
+ stmt => 'INSERT INTO test (a, b, c, d, e) VALUES (?, ?, ?, ?, ?)',
+ stmt_q => 'INSERT INTO `test` (`a`, `b`, `c`, `d`, `e`) VALUES (?, ?, ?, ?, ?)',
+ bind => [qw/1 2 3 4 5/],
+ },
+ #17
+ {
+ func => 'insert',
+ args => ['test', [qw/1 2 3 4 5/]],
+ stmt => 'INSERT INTO test VALUES (?, ?, ?, ?, ?)',
+ stmt_q => 'INSERT INTO `test` VALUES (?, ?, ?, ?, ?)',
+ bind => [qw/1 2 3 4 5/],
+ },
+ #18
+ {
+ func => 'insert',
+ args => ['test', [qw/1 2 3 4 5/, undef]],
+ stmt => 'INSERT INTO test VALUES (?, ?, ?, ?, ?, ?)',
+ stmt_q => 'INSERT INTO `test` VALUES (?, ?, ?, ?, ?, ?)',
+ bind => [qw/1 2 3 4 5/, undef],
+ },
+ #19
+ {
+ func => 'update',
+ args => ['test', {a => 1, b => 2, c => 3, d => 4, e => 5}],
+ stmt => 'UPDATE test SET a = ?, b = ?, c = ?, d = ?, e = ?',
+ stmt_q => 'UPDATE `test` SET `a` = ?, `b` = ?, `c` = ?, `d` = ?, `e` = ?',
+ bind => [qw/1 2 3 4 5/],
+ },
+ #20
+ {
+ func => 'update',
+ args => ['test', {a => 1, b => 2, c => 3, d => 4, e => 5}, {a => {'in', [1..5]}}],
+ stmt => 'UPDATE test SET a = ?, b = ?, c = ?, d = ?, e = ? WHERE ( a IN ( ?, ?, ?, ?, ? ) )',
+ stmt_q => 'UPDATE `test` SET `a` = ?, `b` = ?, `c` = ?, `d` = ?, `e` = ? WHERE ( `a` IN ( ?, ?, ?, ?, ? ) )',
+ bind => [qw/1 2 3 4 5 1 2 3 4 5/],
+ },
+ #21
+ {
+ func => 'update',
+ args => ['test', {a => 1, b => \["to_date(?, 'MM/DD/YY')", '02/02/02']}, {a => {'between', [1,2]}}],
+ stmt => 'UPDATE test SET a = ?, b = to_date(?, \'MM/DD/YY\') WHERE ( a BETWEEN ? AND ? )',
+ stmt_q => 'UPDATE `test` SET `a` = ?, `b` = to_date(?, \'MM/DD/YY\') WHERE ( `a` BETWEEN ? AND ? )',
+ bind => [qw(1 02/02/02 1 2)],
+ },
+ #22
+ {
+ func => 'insert',
+ args => ['test.table', {high_limit => \'max(all_limits)', low_limit => 4} ],
+ stmt => 'INSERT INTO test.table (high_limit, low_limit) VALUES (max(all_limits), ?)',
+ stmt_q => 'INSERT INTO `test`.`table` (`high_limit`, `low_limit`) VALUES (max(all_limits), ?)',
+ bind => ['4'],
+ },
+ #23
+ {
+ func => 'insert',
+ new => {bindtype => 'columns'},
+ args => ['test.table', {one => 2, three => 4, five => 6} ],
+ stmt => 'INSERT INTO test.table (five, one, three) VALUES (?, ?, ?)',
+ stmt_q => 'INSERT INTO `test`.`table` (`five`, `one`, `three`) VALUES (?, ?, ?)',
+ bind => [['five', 6], ['one', 2], ['three', 4]], # alpha order, man...
+ },
+ #24
+ {
+ func => 'select',
+ new => {bindtype => 'columns', case => 'lower'},
+ args => ['test.table', [qw/one two three/], {one => 2, three => 4, five => 6} ],
+ stmt => 'select one, two, three from test.table where ( five = ? and one = ? and three = ? )',
+ stmt_q => 'select `one`, `two`, `three` from `test`.`table` where ( `five` = ? and `one` = ? and `three` = ? )',
+ bind => [['five', 6], ['one', 2], ['three', 4]], # alpha order, man...
+ },
+ #25
+ {
+ func => 'update',
+ new => {bindtype => 'columns', cmp => 'like'},
+ args => ['testin.table2', {One => 22, Three => 44, FIVE => 66},
+ {Beer => 'is', Yummy => '%YES%', IT => ['IS','REALLY','GOOD']}],
+ stmt => 'UPDATE testin.table2 SET FIVE = ?, One = ?, Three = ? WHERE '
+ . '( Beer LIKE ? AND ( ( IT LIKE ? ) OR ( IT LIKE ? ) OR ( IT LIKE ? ) ) AND Yummy LIKE ? )',
+ stmt_q => 'UPDATE `testin`.`table2` SET `FIVE` = ?, `One` = ?, `Three` = ? WHERE '
+ . '( `Beer` LIKE ? AND ( ( `IT` LIKE ? ) OR ( `IT` LIKE ? ) OR ( `IT` LIKE ? ) ) AND `Yummy` LIKE ? )',
+ bind => [['FIVE', 66], ['One', 22], ['Three', 44], ['Beer','is'],
+ ['IT','IS'], ['IT','REALLY'], ['IT','GOOD'], ['Yummy','%YES%']],
+ },
+ #26
+ {
+ func => 'select',
+ args => ['test', '*', {priority => [ -and => {'!=', 2}, {'!=', 1} ]}],
+ stmt => 'SELECT * FROM test WHERE ( ( ( priority != ? ) AND ( priority != ? ) ) )',
+ stmt_q => 'SELECT * FROM `test` WHERE ( ( ( `priority` != ? ) AND ( `priority` != ? ) ) )',
+ bind => [qw(2 1)],
+ },
+ #27
+ {
+ func => 'select',
+ args => ['Yo Momma', '*', { user => 'nwiger',
+ -nest => [ workhrs => {'>', 20}, geo => 'ASIA' ] }],
+ stmt => 'SELECT * FROM Yo Momma WHERE ( ( ( workhrs > ? ) OR ( geo = ? ) ) AND user = ? )',
+ stmt_q => 'SELECT * FROM `Yo Momma` WHERE ( ( ( `workhrs` > ? ) OR ( `geo` = ? ) ) AND `user` = ? )',
+ bind => [qw(20 ASIA nwiger)],
+ },
+ #28
+ {
+ func => 'update',
+ args => ['taco_punches', { one => 2, three => 4 },
+ { bland => [ -and => {'!=', 'yes'}, {'!=', 'YES'} ],
+ tasty => { '!=', [qw(yes YES)] },
+ -nest => [ face => [ -or => {'=', 'mr.happy'}, {'=', undef} ] ] },
+ ],
+# LDNOTE : modified the test below, same reasons as #14 in 00where.t
+ stmt => 'UPDATE taco_punches SET one = ?, three = ? WHERE ( ( ( ( ( face = ? ) OR ( face IS NULL ) ) ) )'
+# . ' AND ( ( bland != ? ) AND ( bland != ? ) ) AND ( ( tasty != ? ) OR ( tasty != ? ) ) )',
+ . ' AND ( ( bland != ? ) AND ( bland != ? ) ) AND ( ( tasty != ? ) AND ( tasty != ? ) ) )',
+ stmt_q => 'UPDATE `taco_punches` SET `one` = ?, `three` = ? WHERE ( ( ( ( ( `face` = ? ) OR ( `face` IS NULL ) ) ) )'
+# . ' AND ( ( `bland` != ? ) AND ( `bland` != ? ) ) AND ( ( `tasty` != ? ) OR ( `tasty` != ? ) ) )',
+ . ' AND ( ( `bland` != ? ) AND ( `bland` != ? ) ) AND ( ( `tasty` != ? ) AND ( `tasty` != ? ) ) )',
+ bind => [qw(2 4 mr.happy yes YES yes YES)],
+ },
+ #29
+ {
+ func => 'select',
+ args => ['jeff', '*', { name => {'like', '%smith%', -not_in => ['Nate','Jim','Bob','Sally']},
+ -nest => [ -or => [ -and => [age => { -between => [20,30] }, age => {'!=', 25} ],
+ yob => {'<', 1976} ] ] } ],
+# LDNOTE : original test below was WRONG with respect to the doc.
+# [-and, [cond1, cond2], cond3] should mean (cond1 OR cond2) AND cond3
+# instead of (cond1 AND cond2) OR cond3.
+# Probably a misconception because of '=>' notation
+# in [-and => [cond1, cond2], cond3].
+# Also some differences in parentheses, but without impact on semantics.
+# stmt => 'SELECT * FROM jeff WHERE ( ( ( ( ( ( ( age BETWEEN ? AND ? ) AND ( age != ? ) ) ) OR ( yob < ? ) ) ) )'
+# . ' AND name NOT IN ( ?, ?, ?, ? ) AND name LIKE ? )',
+# stmt_q => 'SELECT * FROM `jeff` WHERE ( ( ( ( ( ( ( `age` BETWEEN ? AND ? ) AND ( `age` != ? ) ) ) OR ( `yob` < ? ) ) ) )'
+# . ' AND `name` NOT IN ( ?, ?, ?, ? ) AND `name` LIKE ? )',
+ stmt => 'SELECT * FROM jeff WHERE ( ( ( ( ( age BETWEEN ? AND ? ) OR ( age != ? ) ) AND ( yob < ? ) ) )'
+ . ' AND ( name NOT IN ( ?, ?, ?, ? ) AND name LIKE ? ) )',
+ stmt_q => 'SELECT * FROM `jeff` WHERE ( ( ( ( ( `age` BETWEEN ? AND ? ) OR ( `age` != ? ) ) AND ( `yob` < ? ) ) )'
+ . ' AND ( `name` NOT IN ( ?, ?, ?, ? ) AND `name` LIKE ? ) )',
+ bind => [qw(20 30 25 1976 Nate Jim Bob Sally %smith%)]
+ },
+ #30
+ {
+ func => 'update',
+# LDNOTE : removed the "-maybe", because we no longer admit unknown ops
+# args => ['fhole', {fpoles => 4}, [-maybe => {race => [-and => [qw(black white asian)]]},
+ args => ['fhole', {fpoles => 4}, [ {race => [-and => [qw(black white asian)]]},
+ {-nest => {firsttime => [-or => {'=','yes'}, undef]}},
+ [ -and => {firstname => {-not_like => 'candace'}}, {lastname => {-in => [qw(jugs canyon towers)]}} ] ] ],
+ stmt => 'UPDATE fhole SET fpoles = ? WHERE ( ( ( ( ( ( ( race = ? ) OR ( race = ? ) OR ( race = ? ) ) ) ) ) )'
+ . ' OR ( ( ( ( firsttime = ? ) OR ( firsttime IS NULL ) ) ) ) OR ( ( ( firstname NOT LIKE ? ) ) AND ( lastname IN ( ?, ?, ? ) ) ) )',
+ stmt_q => 'UPDATE `fhole` SET `fpoles` = ? WHERE ( ( ( ( ( ( ( `race` = ? ) OR ( `race` = ? ) OR ( `race` = ? ) ) ) ) ) )'
+ . ' OR ( ( ( ( `firsttime` = ? ) OR ( `firsttime` IS NULL ) ) ) ) OR ( ( ( `firstname` NOT LIKE ? ) ) AND ( `lastname` IN ( ?, ?, ? ) ) ) )',
+ bind => [qw(4 black white asian yes candace jugs canyon towers)]
+ },
+ #31
+ {
+ func => 'insert',
+ args => ['test', {a => 1, b => \["to_date(?, 'MM/DD/YY')", '02/02/02']}],
+ stmt => 'INSERT INTO test (a, b) VALUES (?, to_date(?, \'MM/DD/YY\'))',
+ stmt_q => 'INSERT INTO `test` (`a`, `b`) VALUES (?, to_date(?, \'MM/DD/YY\'))',
+ bind => [qw(1 02/02/02)],
+ },
+ #32
+ {
+ func => 'select',
+# LDNOTE: modified test below because we agreed with MST that literal SQL
+# should not automatically insert a '='; the user has to do it
+# args => ['test', '*', { a => \["to_date(?, 'MM/DD/YY')", '02/02/02']}],
+ args => ['test', '*', { a => \["= to_date(?, 'MM/DD/YY')", '02/02/02']}],
+ stmt => q{SELECT * FROM test WHERE ( a = to_date(?, 'MM/DD/YY') )},
+ stmt_q => q{SELECT * FROM `test` WHERE ( `a` = to_date(?, 'MM/DD/YY') )},
+ bind => ['02/02/02'],
+ }
+);
+
+use Data::Dumper;
+
+for (@tests) {
+ local $"=', ';
+
+ my $new = $_->{new} || {};
+ $new->{debug} = $ENV{DEBUG} || 0;
+ my $sql = SQL::Abstract->new(%$new);
+
+ #print "testing with args (@{$_->{args}}): ";
+ my $func = $_->{func};
+ my($stmt, @bind) = $sql->$func(@{$_->{args}});
+ is_same_sql_bind($stmt, \@bind, $_->{stmt}, $_->{bind});
+
+ # test with quoted labels
+ my $sql_q = SQL::Abstract->new(%$new, quote_char => '`', name_sep => '.');
+
+ my $func_q = $_->{func};
+ my($stmt_q, @bind_q) = $sql_q->$func_q(@{$_->{args}});
+
+ is_same_sql_bind($stmt_q, \@bind_q, $_->{stmt_q}, $_->{bind});
+}
+
+
Added: SQL-Abstract/1.x/branches/1.50_RC/t/02where.t
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC/t/02where.t (rev 0)
+++ SQL-Abstract/1.x/branches/1.50_RC/t/02where.t 2008-10-16 22:49:55 UTC (rev 4926)
@@ -0,0 +1,193 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+
+use FindBin;
+use lib "$FindBin::Bin";
+use TestSqlAbstract;
+
+plan tests => 15;
+
+use SQL::Abstract;
+
+# Make sure to test the examples, since having them break is somewhat
+# embarrassing. :-(
+
+my @handle_tests = (
+ {
+ where => {
+ requestor => 'inna',
+ worker => ['nwiger', 'rcwe', 'sfz'],
+ status => { '!=', 'completed' }
+ },
+ order => [],
+ stmt => " WHERE ( requestor = ? AND status != ? AND ( ( worker = ? ) OR"
+ . " ( worker = ? ) OR ( worker = ? ) ) )",
+ bind => [qw/inna completed nwiger rcwe sfz/],
+ },
+
+ {
+ where => {
+ user => 'nwiger',
+ status => 'completed'
+ },
+ order => [qw/ticket/],
+ stmt => " WHERE ( status = ? AND user = ? ) ORDER BY ticket",
+ bind => [qw/completed nwiger/],
+ },
+
+ {
+ where => {
+ user => 'nwiger',
+ status => { '!=', 'completed' }
+ },
+ order => [qw/ticket/],
+ stmt => " WHERE ( status != ? AND user = ? ) ORDER BY ticket",
+ bind => [qw/completed nwiger/],
+ },
+
+ {
+ where => {
+ status => 'completed',
+ reportid => { 'in', [567, 2335, 2] }
+ },
+ order => [],
+ stmt => " WHERE ( reportid IN ( ?, ?, ? ) AND status = ? )",
+ bind => [qw/567 2335 2 completed/],
+ },
+
+ {
+ where => {
+ status => 'completed',
+ reportid => { 'not in', [567, 2335, 2] }
+ },
+ order => [],
+ stmt => " WHERE ( reportid NOT IN ( ?, ?, ? ) AND status = ? )",
+ bind => [qw/567 2335 2 completed/],
+ },
+
+ {
+ where => {
+ status => 'completed',
+ completion_date => { 'between', ['2002-10-01', '2003-02-06'] },
+ },
+ order => \'ticket, requestor',
+#LDNOTE: modified parentheses
+# stmt => " WHERE ( completion_date BETWEEN ? AND ? AND status = ? ) ORDER BY ticket, requestor",
+ stmt => " WHERE ( ( completion_date BETWEEN ? AND ? ) AND status = ? ) ORDER BY ticket, requestor",
+ bind => [qw/2002-10-01 2003-02-06 completed/],
+ },
+
+ {
+ where => [
+ {
+ user => 'nwiger',
+ status => { 'in', ['pending', 'dispatched'] },
+ },
+ {
+ user => 'robot',
+ status => 'unassigned',
+ },
+ ],
+ order => [],
+ stmt => " WHERE ( ( status IN ( ?, ? ) AND user = ? ) OR ( status = ? AND user = ? ) )",
+ bind => [qw/pending dispatched nwiger unassigned robot/],
+ },
+
+ {
+ where => {
+ priority => [ {'>', 3}, {'<', 1} ],
+ requestor => \'is not null',
+ },
+ order => 'priority',
+ stmt => " WHERE ( ( ( priority > ? ) OR ( priority < ? ) ) AND requestor is not null ) ORDER BY priority",
+ bind => [qw/3 1/],
+ },
+
+ {
+ where => {
+ priority => [ {'>', 3}, {'<', 1} ],
+ requestor => { '!=', undef },
+ },
+ order => [qw/a b c d e f g/],
+ stmt => " WHERE ( ( ( priority > ? ) OR ( priority < ? ) ) AND requestor IS NOT NULL )"
+ . " ORDER BY a, b, c, d, e, f, g",
+ bind => [qw/3 1/],
+ },
+
+ {
+ where => {
+ priority => { 'between', [1, 3] },
+ requestor => { 'like', undef },
+ },
+ order => \'requestor, ticket',
+#LDNOTE: modified parentheses
+# stmt => " WHERE ( priority BETWEEN ? AND ? AND requestor IS NULL ) ORDER BY requestor, ticket",
+ stmt => " WHERE ( ( priority BETWEEN ? AND ? ) AND requestor IS NULL ) ORDER BY requestor, ticket",
+ bind => [qw/1 3/],
+ },
+
+
+ {
+ where => {
+ id => 1,
+ num => {
+ '<=' => 20,
+ '>' => 10,
+ },
+ },
+# LDNOTE : modified test below, just parentheses differ
+# stmt => " WHERE ( id = ? AND num <= ? AND num > ? )",
+ stmt => " WHERE ( id = ? AND ( num <= ? AND num > ? ) )",
+ bind => [qw/1 20 10/],
+ },
+
+ {
+ where => { foo => {-not_like => [7,8,9]},
+ fum => {'like' => [qw/a b/]},
+ nix => {'between' => [100,200] },
+ nox => {'not between' => [150,160] },
+ wix => {'in' => [qw/zz yy/]},
+ wux => {'not_in' => [qw/30 40/]}
+ },
+# LDNOTE: modified parentheses for BETWEEN (trivial).
+# Also modified the logic of "not_like" (severe, same reasons as #14 in 00where.t)
+# stmt => " WHERE ( ( ( foo NOT LIKE ? ) OR ( foo NOT LIKE ? ) OR ( foo NOT LIKE ? ) ) AND ( ( fum LIKE ? ) OR ( fum LIKE ? ) ) AND nix BETWEEN ? AND ? AND nox NOT BETWEEN ? AND ? AND wix IN ( ?, ? ) AND wux NOT IN ( ?, ? ) )",
+ stmt => " WHERE ( ( foo NOT LIKE ? AND foo NOT LIKE ? AND foo NOT LIKE ? ) AND ( ( fum LIKE ? ) OR ( fum LIKE ? ) ) AND ( nix BETWEEN ? AND ? ) AND ( nox NOT BETWEEN ? AND ? ) AND wix IN ( ?, ? ) AND wux NOT IN ( ?, ? ) )",
+ bind => [7,8,9,'a','b',100,200,150,160,'zz','yy','30','40'],
+ },
+
+ {
+ where => {
+ id => [],
+ bar => {'!=' => []},
+ },
+ stmt => " WHERE ( 1=1 AND 0=1 )",
+ bind => [],
+ },
+
+
+ {
+ where => {
+ foo => \["IN (?, ?)", 22, 33],
+ bar => [-and => \["> ?", 44], \["< ?", 55] ],
+ },
+ stmt => " WHERE ( (bar > ? AND bar < ?) AND foo IN (?, ?) )",
+ bind => [44, 55, 22, 33],
+ },
+
+);
+
+for my $case (@handle_tests) {
+ my $sql = SQL::Abstract->new;
+ my($stmt, @bind) = $sql->where($case->{where}, $case->{order});
+ is_same_sql_bind($stmt, \@bind, $case->{stmt}, $case->{bind})
+}
+
+dies_ok {
+ my $sql = SQL::Abstract->new;
+ $sql->where({ foo => { '>=' => [] }},);
+}
Added: SQL-Abstract/1.x/branches/1.50_RC/t/03values.t
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC/t/03values.t (rev 0)
+++ SQL-Abstract/1.x/branches/1.50_RC/t/03values.t 2008-10-16 22:49:55 UTC (rev 4926)
@@ -0,0 +1,95 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+
+use FindBin;
+use lib "$FindBin::Bin";
+use TestSqlAbstract;
+
+plan tests => 5;
+
+use SQL::Abstract;
+
+my $sql = SQL::Abstract->new;
+
+my @data = (
+ {
+ user => 'nwiger',
+ name => 'Nathan Wiger',
+ phone => '123-456-7890',
+ addr => 'Yeah, right',
+ city => 'Milwalkee',
+ state => 'Minnesota',
+ },
+
+ {
+ user => 'jimbo',
+ name => 'Jimbo Bobson',
+ phone => '321-456-0987',
+ addr => 'Yo Momma',
+ city => 'Yo City',
+ state => 'Minnesota',
+ },
+
+ {
+ user => 'mr.hat',
+ name => 'Mr. Garrison',
+ phone => '123-456-7890',
+ addr => undef,
+ city => 'South Park',
+ state => 'CO',
+ },
+
+ {
+ user => 'kennyg',
+ name => undef,
+ phone => '1-800-Sucky-Sucky',
+ addr => 'Mr. Garrison',
+ city => undef,
+ state => 'CO',
+ },
+
+ {
+ user => 'barbara_streisand',
+ name => 'MechaStreisand!',
+ phone => 0,
+ addr => -9230992340,
+ city => 42,
+ state => 'CO',
+ },
+);
+
+# Note to self: I have no idea what this does anymore
+# It looks like a cool fucking segment of code though!
+# I just wish I remembered writing it... :-\
+
+my($sth, $stmt);
+my($laststmt, $numfields);
+for my $t (@data) {
+ local $"=', ';
+
+ $stmt = $sql->insert('yo_table', $t);
+ my @val = $sql->values($t);
+ $numfields ||= @val;
+
+ ok((! $laststmt || $stmt eq $laststmt) && @val == $numfields
+ && equal(\@val, [map { $t->{$_} } sort keys %$t])) or
+ print "got\n",
+ "[$stmt] [@val]\n",
+ "instead of\n",
+ "[$t->{stmt}] [stuff]\n\n";
+ $laststmt = $stmt;
+}
+
+sub equal {
+ my ($a, $b) = @_;
+ return 0 if @$a != @$b;
+ for (my $i = 0; $i < $#{$a}; $i++) {
+ next if (! defined($a->[$i])) && (! defined($b->[$i]));
+ return 0 if $a->[$i] ne $b->[$i];
+ }
+ return 1;
+}
+
Added: SQL-Abstract/1.x/branches/1.50_RC/t/06order_by.t
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC/t/06order_by.t (rev 0)
+++ SQL-Abstract/1.x/branches/1.50_RC/t/06order_by.t 2008-10-16 22:49:55 UTC (rev 4926)
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+
+use SQL::Abstract;
+
+use FindBin;
+use lib "$FindBin::Bin";
+use TestSqlAbstract;
+
+my @cases =
+ (
+ {
+ given => \'colA DESC',
+ expects => ' ORDER BY colA DESC',
+ expects_quoted => ' ORDER BY colA DESC',
+ },
+ {
+ given => 'colA',
+ expects => ' ORDER BY colA',
+ expects_quoted => ' ORDER BY `colA`',
+ },
+ {
+ given => [qw/colA colB/],
+ expects => ' ORDER BY colA, colB',
+ expects_quoted => ' ORDER BY `colA`, `colB`',
+ },
+ {
+ given => {-asc => 'colA'},
+ expects => ' ORDER BY colA ASC',
+ expects_quoted => ' ORDER BY `colA` ASC',
+ },
+ {
+ given => {-desc => 'colB'},
+ expects => ' ORDER BY colB DESC',
+ expects_quoted => ' ORDER BY `colB` DESC',
+ },
+ {
+ given => [{-asc => 'colA'}, {-desc => 'colB'}],
+ expects => ' ORDER BY colA ASC, colB DESC',
+ expects_quoted => ' ORDER BY `colA` ASC, `colB` DESC',
+ },
+ {
+ given => ['colA', {-desc => 'colB'}],
+ expects => ' ORDER BY colA, colB DESC',
+ expects_quoted => ' ORDER BY `colA`, `colB` DESC',
+ },
+ );
+
+my $sql = SQL::Abstract->new;
+my $sqlq = SQL::Abstract->new({quote_char => '`'});
+
+plan tests => (scalar(@cases) * 2);
+
+for my $case( @cases){
+ is($sql->_order_by($case->{given}), $case->{expects});
+ is($sqlq->_order_by($case->{given}), $case->{expects_quoted});
+}
Added: SQL-Abstract/1.x/branches/1.50_RC/t/07subqueries.t
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC/t/07subqueries.t (rev 0)
+++ SQL-Abstract/1.x/branches/1.50_RC/t/07subqueries.t 2008-10-16 22:49:55 UTC (rev 4926)
@@ -0,0 +1,95 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+
+use FindBin;
+use lib "$FindBin::Bin";
+use TestSqlAbstract;
+
+plan tests => 5;
+
+use SQL::Abstract;
+
+my $sql = SQL::Abstract->new;
+
+my (@tests, $sub_stmt, @sub_bind, $where);
+
+#1
+($sub_stmt, @sub_bind) = ("SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?",
+ 100, "foo%");
+$where = {
+ foo => 1234,
+ bar => \["IN ($sub_stmt)" => @sub_bind],
+ };
+push @tests, {
+ where => $where,
+ stmt => " WHERE ( bar IN (SELECT c1 FROM t1 WHERE c2 < ? AND c3 LIKE ?) AND foo = ? )",
+ bind => [100, "foo%", 1234],
+};
+
+#2
+($sub_stmt, @sub_bind)
+ = $sql->select("t1", "c1", {c2 => {"<" => 100},
+ c3 => {-like => "foo%"}});
+$where = {
+ foo => 1234,
+ bar => \["> ALL ($sub_stmt)" => @sub_bind],
+ };
+push @tests, {
+ where => $where,
+ stmt => " WHERE ( bar > ALL (SELECT c1 FROM t1 WHERE ( c2 < ? AND c3 LIKE ? )) AND foo = ? )",
+ bind => [100, "foo%", 1234],
+};
+
+#3
+($sub_stmt, @sub_bind)
+ = $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
+$where = {
+ foo => 1234,
+ -nest => \["EXISTS ($sub_stmt)" => @sub_bind],
+ };
+push @tests, {
+ where => $where,
+ stmt => " WHERE ( EXISTS (SELECT * FROM t1 WHERE ( c1 = ? AND c2 > t0.c0 )) AND foo = ? )",
+ bind => [1, 1234],
+};
+
+#4
+$where = {
+ -nest => \["MATCH (col1, col2) AGAINST (?)" => "apples"],
+ };
+push @tests, {
+ where => $where,
+ stmt => " WHERE ( MATCH (col1, col2) AGAINST (?) )",
+ bind => ["apples"],
+};
+
+
+#5
+($sub_stmt, @sub_bind)
+ = $sql->where({age => [{"<" => 10}, {">" => 20}]});
+$sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
+$where = {
+ lname => {-like => '%son%'},
+ -nest => \["NOT ( $sub_stmt )" => @sub_bind],
+ };
+push @tests, {
+ where => $where,
+ stmt => " WHERE ( NOT ( ( ( ( age < ? ) OR ( age > ? ) ) ) ) AND lname LIKE ? )",
+ bind => [10, 20, '%son%'],
+};
+
+
+
+for (@tests) {
+
+ my($stmt, @bind) = $sql->where($_->{where}, $_->{order});
+ is_same_sql_bind($stmt, \@bind, $_->{stmt}, $_->{bind});
+}
+
+
+
+
+
Added: SQL-Abstract/1.x/branches/1.50_RC/t/08special_ops.t
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC/t/08special_ops.t (rev 0)
+++ SQL-Abstract/1.x/branches/1.50_RC/t/08special_ops.t 2008-10-16 22:49:55 UTC (rev 4926)
@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+
+use FindBin;
+use lib "$FindBin::Bin";
+use TestSqlAbstract;
+
+plan tests => 2;
+
+use SQL::Abstract;
+
+my $sqlmaker = SQL::Abstract->new(special_ops => [
+
+ # special op for MySql MATCH (field) AGAINST(word1, word2, ...)
+ {regex => qr/^match$/i,
+ handler => sub {
+ my ($self, $field, $op, $arg) = @_;
+ $arg = [$arg] if not ref $arg;
+ my $label = $self->_quote($field);
+ my ($placeholder) = $self->_convert('?');
+ my $placeholders = join ", ", (($placeholder) x @$arg);
+ my $sql = $self->_sqlcase('match') . " ($label) "
+ . $self->_sqlcase('against') . " ($placeholders) ";
+ my @bind = $self->_bindtype($field, @$arg);
+ return ($sql, @bind);
+ }
+ },
+
+ # special op for Basis+ NATIVE
+ {regex => qr/^native$/i,
+ handler => sub {
+ my ($self, $field, $op, $arg) = @_;
+ $arg =~ s/'/''/g;
+ my $sql = "NATIVE (' $field $arg ')";
+ return ($sql);
+ }
+ },
+
+]);
+
+my @tests = (
+
+ #1
+ { where => {foo => {-match => 'foo'},
+ bar => {-match => [qw/foo bar/]}},
+ stmt => " WHERE ( MATCH (bar) AGAINST (?, ?) AND MATCH (foo) AGAINST (?) )",
+ bind => [qw/foo bar foo/],
+ },
+
+ #2
+ { where => {foo => {-native => "PH IS 'bar'"}},
+ stmt => " WHERE ( NATIVE (' foo PH IS ''bar'' ') )",
+ bind => [],
+ },
+
+);
+
+
+for (@tests) {
+
+ my($stmt, @bind) = $sqlmaker->where($_->{where}, $_->{order});
+ is_same_sql_bind($stmt, \@bind, $_->{stmt}, $_->{bind});
+}
+
+
+
+
+
Added: SQL-Abstract/1.x/branches/1.50_RC/t/TestSqlAbstract.pm
===================================================================
--- SQL-Abstract/1.x/branches/1.50_RC/t/TestSqlAbstract.pm (rev 0)
+++ SQL-Abstract/1.x/branches/1.50_RC/t/TestSqlAbstract.pm 2008-10-16 22:49:55 UTC (rev 4926)
@@ -0,0 +1,137 @@
+package TestSqlAbstract;
+
+# compares two SQL expressions on their abstract syntax,
+# ignoring differences in levels of parentheses.
+
+use strict;
+use warnings;
+use Test::More;
+use base 'Exporter';
+use Data::Dumper;
+
+our @EXPORT = qw/is_same_sql_bind/;
+
+
+my $last_differ;
+
+sub is_same_sql_bind {
+ my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = @_;
+
+ my $tree1 = parse($sql1);
+ my $tree2 = parse($sql2);
+ my $same_sql = eq_tree($tree1, $tree2);
+ my $same_bind = stringify_bind($bind_ref1) eq stringify_bind($bind_ref2);
+ ok($same_sql && $same_bind, $msg);
+ if (!$same_sql) {
+ diag "SQL expressions differ\n"
+ ." got: $sql1\n"
+ ."expected: $sql2\n"
+ ."differing in :\n$last_differ\n";
+ ;
+ }
+ if (!$same_bind) {
+ diag "BIND values differ\n"
+ ." got: " . Dumper($bind_ref1)
+ ."expected: " . Dumper($bind_ref2)
+ ;
+ }
+}
+
+sub stringify_bind {
+ my $bind_ref = shift || [];
+ return join "///", map {ref $_ ? join('=>', @$_) : ($_ || '')}
+ @$bind_ref;
+}
+
+
+
+sub eq_tree {
+ my ($left, $right) = @_;
+
+ # ignore top-level parentheses
+ while ($left->[0] eq 'PAREN') {$left = $left->[1] }
+ while ($right->[0] eq 'PAREN') {$right = $right->[1]}
+
+ if ($left->[0] ne $right->[0]) { # if operators are different
+ $last_differ = sprintf "OP [$left->[0]] != [$right->[0]] in\nleft: %s\nright: %s\n",
+ unparse($left),
+ unparse($right);
+ return 0;
+ }
+ else { # else compare operands
+ if ($left->[0] eq 'EXPR' ) {
+ if ($left->[1] ne $right->[1]) {
+ $last_differ = "[$left->[1]] != [$right->[1]]\n";
+ return 0;
+ }
+ else {
+ return 1;
+ }
+ }
+ else {
+ my $eq_left = eq_tree($left->[1][0], $right->[1][0]);
+ my $eq_right = eq_tree($left->[1][1], $right->[1][1]);
+ return $eq_left && $eq_right;
+ }
+ }
+}
+
+
+my @tokens;
+
+sub parse {
+ my $s = shift;
+
+ # tokenize string
+ @tokens = grep {!/^\s*$/} split /\s*(\(|\)|\bAND\b|\bOR\b)\s*/, $s;
+
+ my $tree = _recurse_parse();
+ return $tree;
+}
+
+sub _recurse_parse {
+
+ my $left;
+ while (1) {
+
+ my $lookahead = $tokens[0];
+ return $left if !defined($lookahead) || $lookahead eq ')';
+
+ my $token = shift @tokens;
+
+ if ($token eq '(') {
+ my $right = _recurse_parse();
+ $token = shift @tokens
+ or die "missing ')'";
+ $token eq ')'
+ or die "unexpected token : $token";
+ $left = $left ? [CONCAT => [$left, [PAREN => $right]]]
+ : [PAREN => $right];
+ }
+ elsif ($token eq 'AND' || $token eq 'OR') {
+ my $right = _recurse_parse();
+ $left = [$token => [$left, $right]];
+ }
+ else {
+ $left = $left ? [CONCAT => [$left, [EXPR => $token]]]
+ : [EXPR => $token];
+ }
+ }
+}
+
+
+
+sub unparse {
+ my $tree = shift;
+ my $dispatch = {
+ EXPR => sub {$tree->[1] },
+ PAREN => sub {"(" . unparse($tree->[1]) . ")" },
+ CONCAT => sub {join " ", map {unparse($_)} @{$tree->[1]}},
+ AND => sub {join " AND ", map {unparse($_)} @{$tree->[1]}},
+ OR => sub {join " OR ", map {unparse($_)} @{$tree->[1]}},
+ };
+ $dispatch->{$tree->[0]}->();
+}
+
+
+1;
More information about the Bast-commits
mailing list